1.1 Ausgangslage

Die Bestellung von Bäckereien ist häufig noch ein manueller und zeitaufwändiger Prozess, der auf adjustierten Vorwochenwerten basiert. Eine systematische Planung unter Einbeziehung von Mustern findet nur eingeschränkt statt.

1.2 Zielsetzung

Wir testen verschiedene einfache und komplexe Modelle und bedienen uns dabei an Techniken aus den Bereichen Statistik, Machine Learning und Deep Learning. Möglicherweise finden wir ein Verfahren, dass den anderen überlegen ist und die beste Prognosegüte für alle Warengruppen aufweist.

Andererseits kann es sich herausstellen, dass das Verhalten der Warengruppen zu unterschiedlich ist und wir verschiedene Techniken für verschiedene Warengruppen benötigen.

In jedem Fall werden Prognosemodelle entworfen, die Bäckereien eine bessere Planungsgrundlage auf Warengruppenebene bieteen sollen.

Lösungsansatz

Mit Hilfe von verschiedenen Daten und Einflussfaktoren sollen die Umsätze je Warengruppe prognostiziert werden.

Abhängige / zu prognostizierende Variable:

• Umsatzdaten

Unabhängige / beeinflussende Variablen:

• Wetterdaten,
• Veranstaltungsdaten,
• Wochentage,
• Feiertage (sowie Feiertage inkl. Brückentage),
• Ferienzeiten
• Jahreszeiten

1.3 Datenbasis

Untersucht werden Daten für die Jahre 2013 bis 2019. Es liegen für diesen Zeitraum als Rohdaten drei Datensätze vor:

• Umsätze je Warengruppe und Tag
• Es werden fünf Warengruppen in die Analysen einbezogen: Brot (WG 1), Brötchen (WG 2), Croissant (WG 3), Konditorei (WG 4) und Kuchen (WG 5)
• Daten zur Kieler Woche
• Wetterdaten
  • Informationen zu den Wetterdaten können der privaten Webseite von Mario Lehwald entnommen werden. Herr Lehwald hat seine Daten wiederum vom Geomar - Helmholtz-Zentrum für Ozeanforschung Kiel sowie vom Windfinder bezogen (vgl. Impressum)

2.1 Einlesen der Daten

Im ersten Schritt müssen die Daten zunächst eingelesen werden um sie bearbeiten zu können:

# mit read_csv einlesen um eine Veränderung der Datentypen (bzw. eine Faktorisierung) zu verhindern!
Beispieldaten <- read_csv("data/Beispieldaten.csv")
KiWo <- read_csv("data/KiWo.csv")
Wetter <- read_csv("data/Wetter.csv")

2.2 Überprüfung der Datenstrukturen

• Datensatz Beispieldaten

str(Beispieldaten)

## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 11164 obs. of  3 variables:
##  $ Datum      : Date, format: "2013-07-01" "2013-07-02" ...
##  $ Warengruppe: num  1 1 1 1 1 1 1 1 1 1 ...
##  $ Umsatz     : num  149 160 112 169 171 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Datum = col_date(format = ""),
##   ..   Warengruppe = col_double(),
##   ..   Umsatz = col_double()
##   .. )

glimpse(Beispieldaten)

## Observations: 11,164
## Variables: 3
## $ Datum       <date> 2013-07-01, 2013-07-02, 2013-07-03, 2013-07-04, 2...
## $ Warengruppe <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...
## $ Umsatz      <dbl> 148.82835, 159.79376, 111.88559, 168.86494, 171.28...

typeof(Beispieldaten$Datum)

## [1] "double"

max(Beispieldaten$Datum)

## [1] "2019-07-30"

range(Beispieldaten$Warengruppe)

## [1] 1 6

range(Beispieldaten$Umsatz)

## [1]    7.051201 1879.461831

head(Beispieldaten)

## # A tibble: 6 x 3
##   Datum      Warengruppe Umsatz
##   <date>           <dbl>  <dbl>
## 1 2013-07-01           1   149.
## 2 2013-07-02           1   160.
## 3 2013-07-03           1   112.
## 4 2013-07-04           1   169.
## 5 2013-07-05           1   171.
## 6 2013-07-06           1   175.

tail(Beispieldaten)

## # A tibble: 6 x 3
##   Datum      Warengruppe Umsatz
##   <date>           <dbl>  <dbl>
## 1 2018-12-21           6   51.8
## 2 2018-12-22           6   66.7
## 3 2018-12-23           6   50.0
## 4 2018-12-24           6   46.1
## 5 2018-12-27           6   51.6
## 6 2018-12-28           6   35.2

Der Datensatz Beispieldaten ist ein Dataframe, enthält 11164 Zeilen und 3 Variablen:

• Datum (date)
• Warengruppe (int) mit den Warengruppen 1 - 6
• Umsatz (dbl) mit Werten zwischen 7.05 und 1879.46.

Umsätze werden jeweils 5 mit Nachkommastellen angezeigt. Hier wird später eine Änderung vorgenommen und die Variable auf zwei Nachkommastellen gerundet.

• Datensatz KiWo

str(KiWo)

## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 72 obs. of  2 variables:
##  $ Datum      : Date, format: "2012-06-16" "2012-06-17" ...
##  $ KielerWoche: num  1 1 1 1 1 1 1 1 1 1 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Datum = col_date(format = ""),
##   ..   KielerWoche = col_double()
##   .. )

glimpse(KiWo)

## Observations: 72
## Variables: 2
## $ Datum       <date> 2012-06-16, 2012-06-17, 2012-06-18, 2012-06-19, 2...
## $ KielerWoche <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,...

any(KiWo$KielerWoche != 1)  # Prüfung: Ist die Ausprägung in irgendeiner Zelle der Spalte ungleich 1?

## [1] FALSE

all(KiWo$KielerWoche == 1)  # Prüfung: Sind alle Ausprägungen gleich 1? 

## [1] TRUE

Der Datensatz KiWo enthält 71 Zeilen und die beiden Variablen Datum (date) und KielerWoche (int), wobei die einzige Ausprägung der Variablen KielerWoche die Ziffer 1 ist. Anhand der Daten der einzelnen Daten erkennt man, dass der Datensatz nur solche Daten enthält, an denen tatsächlich die Kieler Woche in dem jeweiligen Jahr stattgefunden hat.

• Datensatz Wetter

str(Wetter)

## Classes 'spec_tbl_df', 'tbl_df', 'tbl' and 'data.frame': 2601 obs. of  5 variables:
##  $ Datum              : Date, format: "2012-01-01" "2012-01-02" ...
##  $ Bewoelkung         : num  8 7 8 4 6 3 7 7 8 6 ...
##  $ Temperatur         : num  9.82 7.44 5.54 5.69 5.3 ...
##  $ Windgeschwindigkeit: num  14 12 18 19 23 10 14 10 12 10 ...
##  $ Wettercode         : num  58 NA 63 80 80 NA 61 80 61 NA ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   Datum = col_date(format = ""),
##   ..   Bewoelkung = col_double(),
##   ..   Temperatur = col_double(),
##   ..   Windgeschwindigkeit = col_double(),
##   ..   Wettercode = col_double()
##   .. )

glimpse(Wetter)

## Observations: 2,601
## Variables: 5
## $ Datum               <date> 2012-01-01, 2012-01-02, 2012-01-03, 2012-...
## $ Bewoelkung          <dbl> 8, 7, 8, 4, 6, 3, 7, 7, 8, 6, 6, 7, 2, 3, ...
## $ Temperatur          <dbl> 9.825000, 7.437500, 5.537500, 5.687500, 5....
## $ Windgeschwindigkeit <dbl> 14, 12, 18, 19, 23, 10, 14, 10, 12, 10, 16...
## $ Wettercode          <dbl> 58, NA, 63, 80, 80, NA, 61, 80, 61, NA, 51...

range(Wetter$Bewoelkung, na.rm = TRUE)

## [1] 0 8

range(Wetter$Temperatur, na.rm = TRUE)

## [1] -10.25000  32.67143

range(Wetter$Windgeschwindigkeit)

## [1]  3 35

range(Wetter$Wettercode, na.rm = TRUE)

## [1]  0 95

Der Datensatz Wetter enthält 2601 Zeilen und fünf Variablen:

• Datum (date)
• Bewoelkung (int) mit Werte von 0 bis 8
• Temperatur (dbl) mit Werten zwischen -10.25 und 32.67 Grad Celsius
• Windgeschwindigkeit (int) mit Werten zwischen 3 und 35 Knoten
• Wettercode (int) mit Werten zwischen 0 und 95, wobei die einzelnen Wettercodes einer bestimmten Wettererscheinung oder einem bestimmten Wetterzustand entsprechen.

Weitere Informationen zu den einzelnen Variablen des Datensatzes Wetter und ihrer Interpretation können der privaten Webseite Seewetter Kiel entnommen werden.

Alle Datensätze enthalten die Variable Datum. Folglich können die einzelnen Datensätze später über diese Variable vereinigt werden.

2.3 Überprüfung des Anfangs- und Endzeitpunkt der Datumsattribute in den Datensätzen

range(Beispieldaten$Datum)

## [1] "2013-07-01" "2019-07-30"

range(KiWo$Datum)

## [1] "2012-06-16" "2019-06-30"

range(Wetter$Datum)

## [1] "2012-01-01" "2019-08-01"

• Die Daten des Datensatzes Beispieldaten reichen vom 01.07.2013 bis zum 30.07.2019.
• Die Daten des Datensatzes KiWo reichen vom 16.06.2012 bis zum 30.06.2019.
• Die Daten des Datensatzes Wetter reichen vom 01.01.2012 bis zum 01.08.2019.

2.4 Überprüfung der Datensätze auf fehlende Werte

sum(is.na(Beispieldaten))   # 0

## [1] 0

sum(is.na(KiWo))            # 0

## [1] 0

sum(is.na(Wetter))          # 679 fehlende Werte

## [1] 679

# which(is.na(Wetter))
sum(is.na(Wetter$Datum))

## [1] 0

sum(is.na(Wetter$Bewoelkung))   # 10 fehlende Werte

## [1] 10

sum(is.na(Wetter$Temperatur))   # 0

## [1] 0

sum(is.na(Wetter$Windgeschwindigkeit)) # 0

## [1] 0

sum(is.na(Wetter$Wettercode))   # 669 fehlende Werte

## [1] 669

2.5 Überprüfung des Datensatzes auf Vollständigkeit

In In einem weiteren Schritt wird geprüft, ob die Anzahl der Zeilen pro Jahr stimmt.

In den Jahren 2014, 2015, 2017 und 2018, die vollständig vorliegen, müssten es je Warengruppe 365 Zeilen sein, im Schaltjahr 2016 366. Für das Jahr 2013, für das Daten erst ab dem 01.07.2013 zur Verfügung stehen, entsprechend 183 und für das unvollständige Jahr 2019 müssten 210 Datensätze vorliegen. Insgesamt müssten für jede Warengruppe demnach 2219 Zeilen vorhanden sein.

Beispieldaten <- Beispieldaten %>% mutate(Jahr = year(Datum))

# 2174 -> 45 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174

# 2174 -> 45 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174

# 2174 -> 45 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174

# 2120 -> 99 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1  2120

# 2174 -> 45 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1  2174

Es fehlen bei allen Warengruppen Datensätze. Bei den Warengruppen 1,2, 3 und 5 fallen ca. 70% der fehlenden Daten auf Feiertage (insb. Karfreitag, Tag der Arbeit und 1. und 2. Weihnachtsfeiertag). Bei Warengruppe 4 sind es ca. 30%. Weitere ~30% der fehlenden Daten der Warengruppe 4 liegen in den Sommermonaten Juni, Juli, August. Eine Möglichkeit wäre, dass die Kühlung ausgefallen ist / einen Defekt hatte und demzufolge keine Konditoreiwaren angeboten wurden. Eine andere Möglichkeit wäre, dass bei sehr trockenem, warmen Wetter der Verkauf von Konditoreiwaren in der Regel ein Minusgeschäft ist und daher das Sortiment temporär/tageweise verkleinert wird. Auffällig ist, dass die Anzahl der fehlenden Werte pro Jahr abnehmend ist und sich insbesondere in den Jahren 2013 und 2018 mehrheitlich auf Feiertage beschränkt.

Untersucht man die einzelnen Jahre genauer, ergibt sich folgendes Bild:

# 181 -> ein Datum fehlt
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2013) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   181

# 181 -> ein Datum fehlt
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2013) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   181

# 181 -> ein Datum fehlt
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2013) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   181

# 165 -> 17 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2013) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   165

# 181 -> ein Datum fehlt
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2013) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   181

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2014) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2014) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2014) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 334 -> 31 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2014) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   334

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2014) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 360 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2015) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   360

# 360 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2015) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   360

# 360 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2015) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   360

# 350 -> 15 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2015) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   350

# 360 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2015) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   360

# 356 -> 10 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2016) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   356

# 356 -> 10 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2016) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   356

# 356 -> 10 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2016) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   356

# 352 -> 14 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2016) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   352

# 356 -> 10 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2016) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   356

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2017) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2017) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2017) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2017) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2017) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 358 -> 7 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2018) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   358

# 358 -> 7 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2018) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   358

# 358 -> 7 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2018) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   358

# 357 -> 8 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2018) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   357

# 358 -> 7 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2018) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   358

# 205 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 1 & Jahr == 2019) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   205

# 205 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 2 & Jahr == 2019) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   205

# 205 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 3 & Jahr == 2019) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   205

# 205 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 4 & Jahr == 2019) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   205

# 205 -> 5 Daten fehlen
Beispieldaten %>%
  filter(Warengruppe == 5 & Jahr == 2019) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   205

Je Warengruppe und Jahr fehlen unterschiedliche viele Datensätze.

2.6 Überprüfung der Datensätze auf Ausreißer

Ein Ausreißer ist ein Wert, der außerhalb der üblichen Struktur einer Verteilung liegt. Zunächst wird in einem ersten Schritt mittels einer Visualisierung in Form von boxplots überprüft, ob die einzelnen Datensätze überhaupt Ausreißer enthalten.

Ein Boxplot zeigt uns den Median (dicke Linie) sowie das untere und obere Quartil (als Box). Der Abstand von unterem zu oberem Quartil (interquartile range: IQR) wird standardmäßig mit 1.5 multipliziert. Und genau über die auf diese Art ermittelte Spannweite erstrecken sich die sogenannten whiskers maximal, wobei die whiskers unten und oben an der Box ansetzen. Gibt es darüber hinaus noch Werte, die weiter außerhalb liegen, werden diese als Ausreißer durch Punkte gekennzeichnet.

Die Überprüfung wird begonnen mit dem Datensatz Beispieldaten:

# Überprüfung der Variable Umsatz
summary(Beispieldaten$Umsatz)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##    7.051   97.787  165.494  208.308  282.592 1879.462

boxplot(Beispieldaten$Umsatz)

hist(Beispieldaten$Umsatz)

# Visualisierung
Beispieldaten %>% 
  dplyr::select(Umsatz) %>% 
  ggplot(aes(Umsatz)) +
  geom_density()

Das Attribut Umsatz enthält zahlreiche Ausreißer. Mit bloßem Auge ist nicht zu erkennen, wie viele Ausreißer es genau sind. Die Ausreißer werden also in einem 2. Schritt genauer betrachtet, um die genaue Anzahl der Ausreißer zu ermitteln. Statistiker haben viele Verfahren entwickelt, um auseinanderzuhalten, was man als Ausreißer bezeichnen sollte, und was nicht.

Wir verwenden - wie bereits erwähnt - die Standardeinstellung, die aus einer Definition von John W. Tukey stammt: Sie definiert einen Ausreißer als einen Punkt, der mehr als \[1,5 * IQR\] vom unteren bzw. oberen Quartil abweicht. Anders gesagt liegen untere Ausreißer unterhalb

\[Q_1 - 1,5 * IQR\] und obere Ausreißer oberhalb

\[Q_3 + 1.5 * IQR\]

Vereinfachend untersuchen wir nun die Umsatzvariable insgesamt auf Ausreißer, wobei wir zunächst nicht nach Warengruppen trennen:

g_oben <- quantile(Beispieldaten$Umsatz, probs=0.75) + (1.5*IQR(Beispieldaten$Umsatz)) #Obere Grenze fuer Ausreißer
g_oben

##      75% 
## 559.7999

Beispieldaten %>%
  dplyr::select(Umsatz) %>%
  filter(Umsatz > g_oben) %>%
  summarise(n = n())

## # A tibble: 1 x 1
##       n
##   <int>
## 1   348

Die obere Grenze für Ausreißer liegt demzufolge bei 559,80€ (gerundet). Es gibt insgesamt 348 Ausreißer in der Variable Umsatz. In einem 3. Schritt betrachten wir, an welchen Daten diese Ausreißer auftreten und ob Muster erkennbar sind (z. B. überproportional hohe Umsätze an Ostern oder anderen Feiertagen, in den Ferien, während der Kieler Woche o. Ä.):

Beispieldaten %>%
  dplyr::select(Datum, Umsatz, Warengruppe) %>%
  filter(Umsatz > g_oben) 

## # A tibble: 348 x 3
##    Datum      Umsatz Warengruppe
##    <date>      <dbl>       <dbl>
##  1 2013-07-06   632.           2
##  2 2013-07-07   695.           2
##  3 2013-07-09   586.           2
##  4 2013-07-10   567.           2
##  5 2013-07-11   569.           2
##  6 2013-07-12   600.           2
##  7 2013-07-13   747.           2
##  8 2013-07-14   777.           2
##  9 2013-07-15   597.           2
## 10 2013-07-17   628.           2
## # ... with 338 more rows

Beispieldaten %>%
  dplyr::select(Datum, Umsatz, Warengruppe) %>%
  filter(Umsatz > g_oben) %>%
  arrange(desc(Umsatz))

## # A tibble: 348 x 3
##    Datum      Umsatz Warengruppe
##    <date>      <dbl>       <dbl>
##  1 2014-12-31  1879.           5
##  2 2015-12-31  1870.           5
##  3 2016-12-31  1705.           5
##  4 2018-12-31  1668.           5
##  5 2013-12-31  1626.           5
##  6 2017-12-31  1432.           5
##  7 2014-05-05  1203.           2
##  8 2013-08-03   931.           2
##  9 2014-08-09   875.           2
## 10 2013-07-28   872.           2
## # ... with 338 more rows

Beispieldaten %>%
 dplyr::select(Datum, Umsatz, Warengruppe) %>%
 filter(Datum == "2018-12-31")

## # A tibble: 4 x 3
##   Datum      Umsatz Warengruppe
##   <date>      <dbl>       <dbl>
## 1 2018-12-31   264.           1
## 2 2018-12-31   618.           2
## 3 2018-12-31   255.           3
## 4 2018-12-31  1668.           5

Erste Erkenntnisse (nach Jahren sortiert):

2013

• Eine erste Ausreißerperiode ist - mit zwei Ausnahmetagen (Mo, 08.07.; Di, 16.07.) - in dem Zeitraum vom 06.07.2013 (Samstag) bis zum 04.08.2013 (Sonntag) zu beaobachten. Vergleicht man diese Periode mit den Ferienzeiten der verschiedenen Bundesländer im Jahr 2013, so fällt auf, dass insbesondere die für den Tourismus in Schleswig-Holstein relevanten Bundesländer Hessen, Niedersaschsen, Rheinland-Pfalz, sowie teilweise Nordrhein-Westfalen (ab. 22.07.) in diesem Zeitraum Ferien hatten. Weiterhin lagen auch die Ferien der Berliner und der Schleswig-Holsteiner selbst sowie die der Bayern teilweise in diesem Zeitraum. Die Vermutung liegt insofern nahe, dass die Sommerferien einen signifikanten Einfluss auf die Höhe des Umsatzes der betrachtenen Filiale haben.
• Nach dieser wirklich sichtbaren, anhaltenden Periode von überproportional hohen Umsätzen folgt eine Phase - beginnend am Samstag, 10.08.2013 -, in der ausschließlich an den beiden Wochenendtagen Ausreißer-Umsätze zu beobachten sind. Diese Phase endet am 08.09.2013 (Ausnahme in dieser Phase ist So, 01.09.).
• Nach dieser Wochenend-Ausreißerphase wird es erkennbar unregelmäßiger:
  • vereinzelt gibt es weiterhin Ausreißer an Wochenendtagen (z. B. am So, 28.09.; So, 17.11.; So, 24.11.; 01.12.; 25.12.)
  • auch an einzelnen Feiertagen / besonderen Ereignissen sind die Umsätze überproportional stark (03.10. (Tag der Deutschein Einheit); 31.12. (Silvester)).
  • die Herbst- und Winterferien sowie Weihnachten bzw. die Weihnachtsfeiertage scheinen insofern keinen signifikanten Einfluss auf die Umsätze der Bäckerei zu haben.
• Insgesamt gibt es im Jahr 2013 zwei Tage (So, 11.08. und Di, 31.12.), an denen zwei Warengruppen Ausreißer sind (jeweils Warengruppen 2 + 5).

2014

• Das Jahr 2014 beginnt strukturell so wie das Vorjahr geendet hat: unregelmäßig. Vereinzelt gibt es Ausreißer an Wochenendtagen (So, 12.01.; jeweils der Sonntag in der Zeit vom 09.02. - 09.03.; Sa, 29.03.; So, 06.04.).
• Ab Sa, 12.04. bis Ende April am So, 27.04. sind jeweils beide Wochenendtage überproportional stark (Anmerkung: Ferienzeit in vielen relevanten Bundesländern); auch an Ostern (Karfreitag 18.04., Ostersonntag 20.04. sowie Ostermontag 21.04.) sind starke Umsatz-Effekte zu beobachten.
• Ein ungewöhnlich hoher Umsatz ist am Montag, 05.05.2014 zu beobachten; es ist der höchste Umsatz im gesamten Zeitraum; ansonsten gibt es an den Sonntagen 18.05 und 25.05. Ausreißer sowie an Christi Himmelfaht (29.05.).
• Im Zeitraum vom 31.05. bis 29.06. erstrecken sich die Ausreißer wiederum über beide Wochentage; hinzu kommt in diesem Zeitraum ein (eingeschränkter) Effekt der Kieler Woche (Ausreißer am Do, 26.06. und Fr, 27.06.).
• Im Juli sind am Sa, 05.07. sowie von Fr, 11.07. - So, 13.07 die “üblichen” Wochenendeffekte zu beobachten.
• Im Zeitraum vom 17.07. - 31.08 - also in einem Zeitraum von ca. 6 Wochen - jeden Tag Ausreißer zu verzeichnen; betrachtet man die Sommerferienzeiträume der Bundesländer im Jahr 2014, so liegt die Vermutung nahe, dass wie schon im Vorjahr die Ferienzeit diese überporportional hohen Umsätze signifkant beeinflusst hat.
• An den ersten drei Septemberwochenenden sowie an den Oktoberwochenenden sind ebenfalls Ausreißer zu verzeichnen; hinzu kommt im Oktober zudem der Tag der Deutschen Einheit.
• Im November beschränken sich die Ausreißerumsätze auf die Sonntage; dies gilt mit Ausnahme des So, 21.12. auch für den Dezember; hinzu kommen im Dezember weiterhin der Di, 30. und der Mi, 31.12; auch im Jahr 2014 ist wieder kein “Weihnachts-Effekt” sichtbar.
• Insgesamt gibt es im Jahr 2014 einen Tag (Mi, 31.12.), an denen zwei Warengruppen Ausreißer sind (jeweils WG 2 + 5). Am 05.05. gibt es sogar Ausreißer in drei Warengruppen (WG 2, 3, 5).
• Mit mehr als 120 Ausreißern innerhalb eines Jahres ist das Jahr 2014 ein vglw. außergewöhnlich “ausreißerstarkes” Jahr (gewöhnlich liegt die Anzahl pro Jahr zwischen ~ 30 - 50 Ausreißern). Man könnte das Jahr 2014 selbst fast als Ausreißerjahr bezeichnen.

2015

• Im Zeitraum Januar bis März sind insgesamt nur vier Ausreißer zu beobachten; diese liegen jeweils auf einem Sonntag
• Das Osterwochenende im April (So, 05.04 + Mo, 06.04.) ist gewohnt stark; im Unterschied zu 2014 ist jedoch an Karfreitag kein Ausreißer-Umsatz zu verzeichnen. Ansonsten ist der April nicht von Ausreißern betroffen.
• Der Monat Mai + Anfang sind vergleichbar mit dem Vorjahr: überproportional hohe Umsätze am Sonntag nach Himmelfahrt (17.05.) sowie am Pfingstwochende (So, 24. + Mo, 25.05.).
• Der Juni erscheint schwächer als im Vorjahr; es ist lediglich ein leichter Wochenendeffekt sichtbar (Sa, 13.06., Sa, 20.06; sowie am zweiten “KiWo-Wochenende” 27. + 28.06.), der Effekt der Kieler Woche ist schwächer im Vergleich zum Vorjahr.
• Auch im Jahr 2015 scheinen die Sommerferien einen Einfluss zu haben, jedoch einen geringeren als im Vorjahr:
  • im Juli sind in den ersten drei Wochen (01.07. - 19.07.) nur Wochenendeffekte zu beobachten
  • die Phase, in der jeder Tag ein Ausreißer ist, erstreckt sich 2015 nur über 3 Wochen (20.07. - 09.08.); in der Woche vom 10.08 - 16.08. sind zwar noch vier Ausreißer zu verzeichnen, ansonsten beschränken sich die Ausreißer im Rest des Augustes auf die Wochenenden.
• Der nächste und einzige weitere Ausreißer im Jahr 2015 ist an Silvester zu beobachten.

2016

• Im Jahr 2016 taucht der erste Ausreißer am Sonntag des ersten Februarwochenendes auf (07.02.).
• Das Osterwochenende Ende März (Sa, 04.04 + Mo, 06.04.) ist abermals stark, an jedem Tag sind Ausreißer zu finden.
• Im April gibt es im Jahr 2016 keinen einzigen Ausreißer, wobei in diesem Jahr auch kein Feiertag in den April fällt.
• Wie schon im Vorjahr ist an Christi Himmelfahrt (05.05.) selbst kein Ausreißer zu beobachten, wohl aber an dem darauf folgenden Sonntag (wie 2015). Ein weiterer Ausreißer im Mai liegt auf dem Pfingstmontag (16.05.).
• Die Kieler Woche-Umsätze sind abermals schwach mit Blick auf Ausreißer; lediglich am 2. KiWo-Wochenende sind Ausreißer zu verzeichnen.
• Die Sommerferienzeit von Ende Juli bis Mitte August ist wie gewohnt mit vielen Ausreißern versehen, jedoch weniger als in den beiden Vorjahren. Ende August beschränken sich die Ausreißer auf die beiden Wochenendtage.
• Der Rest des Jahres verläuft ausreißertechnisch typisch. Es gibt zwei vereinzelte Ausreißer an zwei Sonntagen (02.10. und 18.12); Silvester ist erwartbar stark, sowohl in Warengruppe 2 als auch in Warengruppe 5.

2017

• Was AUsreißer anbelangt, ist das Jahr 2017 ein auffällig schwaches Jahr. Es ist mit knapp 30 Ausreißern im ganzen Jahr das schwächste von allen (Vgl. 2014: > 120).
• Die ersten beiden Ausreißer sind erst im April am Osterwochenende (15. + 16.04.) zu beobachten; ein weiterer Ausreißer kommt am letzten Aprilsonntag vor, im Mai gibt es nur einen Ausreißer am Sonntag nach Christi Himmelfahrt.
• Im Juni gibt es einen bemerkenswerten Ausreißer am Mo, 05.06. (Montag generell ungewöhnlich für Ausreißer); weiterhin sind an den beiden KiWo-Wochenenden Ausreißer zu verzeichnen.
• Ein gewisser Sommerferieneffekt ist sichtbar, dieser ist jedoch deutlich schwächer al sin den Vorjahren.
• Bemerkenswert ist ein zweiter Ausreißer an Heiligabend. 2017 ist das einzige Jahr, in dem Weihnachten bzw. genauer Heiligabend einen Ausreißer in der Warengruppe 2 zu verzeichnen hat.
• Zudem ist 2017 das einzige Jahr, in dem an Silvester kein Ausreißer in Warengruppe 2 zu beobachten ist.

Fazit: Insgesamt ein eher untypisches Jahr was Ausreißer anbelangt, sowohl von der Anzahl her als auch teilweise von der Verteilung.

2018

• Im Jahr 2018 gibt es einen ersten Ausreißer am Ostersonntag Anfang April (01.04.); der Mai profitiert von der Lage von Christi Himmelfahrt und Pfingsten.
• Im Juni sind an den beiden Wochenenden vor der KiWo einzelne Ausreißer zu verzeichnen; das erste KiWo-Wochenende ist stark. Insbesondere der Sa, 23.06. ist auffällig, das es der einzige Samstag ist, an dem für zwei Warengruppen (2 + 5) Ausreißer zu verzeichnen sind.
• Der gewohnte Sommerferien-Effekt ist von Mitte Juli bis Mitte August bemerkbar und wieder deutlich stärker als im Vorjahr. Ein letzter Ausreißer im August ist am Sa, 25.08. zu verzeichnen. Danach gibt es im gesamten Jahresverlauf nur noch den gewohnten Silvesterausreißer.

2019

• Im Jahr 2019 gibt es zwei vereinzelte Sonntags-Ausreißer Ende Februar und Ende März.
• Ostern, Christi Himmelfahrt und Pfingsten sind gewohnt stark:
  • Ostern: Ausreißer von Sa, 20.04. - Mo, 22.04.
  • Christi Himmelfahrt: Sowohl an Christi Himmelfahrt selbst (30.05.) als auch am darauffolgenden Samstag (01.06.) sind Ausreißer beobachtbar.
  • Am Pfingstwochenende (Sa, 08. - Mo, 10.06.) sind an allen Tagen Ausreißer zu verzeichnen.
• Wiederum stark im Juni sind die beiden Kieler Woche-Wochenenden (22.-23. sowie 29.-30.06.).
• Der Sommerferieneffekt beginnt Mitte Juli (Sa, 13.07.) und hält bis zum Ende des Monats an.

Am Ende der Auswertung wird deutlich, dass für einzelne Daten, z. B. den 05.05.2014, auffällig hohe Umsätze in mehreren Warengruppen vorliegen. Eine Überprüfung auf doppelt belegte Daten ergibt:

Beispieldaten %>%
  dplyr::select(Datum, Umsatz, Warengruppe) %>%
  filter(Umsatz > g_oben) %>%
  arrange(desc(Umsatz)) %>%
  filter(duplicated(Datum))

## # A tibble: 9 x 3
##   Datum      Umsatz Warengruppe
##   <date>      <dbl>       <dbl>
## 1 2014-05-05   749.           5
## 2 2018-06-23   662.           5
## 3 2015-12-31   644.           2
## 4 2014-12-31   643.           2
## 5 2018-12-31   618.           2
## 6 2013-12-31   586.           2
## 7 2013-08-11   583.           5
## 8 2016-12-31   570.           2
## 9 2014-05-05   566.           3

# Gegenprüfung
Beispieldaten %>%
  dplyr::select(Datum, Umsatz) %>%
  filter(Umsatz > g_oben) %>%
  arrange(desc(Umsatz)) %>%
  distinct(Datum) 

## # A tibble: 339 x 1
##    Datum     
##    <date>    
##  1 2014-12-31
##  2 2015-12-31
##  3 2016-12-31
##  4 2018-12-31
##  5 2013-12-31
##  6 2017-12-31
##  7 2014-05-05
##  8 2013-08-03
##  9 2014-08-09
## 10 2013-07-28
## # ... with 329 more rows

Für acht Daten ergibt sich, dass für diese mehrere Umsätze für einen Tag eingetragen wurden:

• 2013-08-11: 666.91€ (WG 2), 583.49 € (WG 5)
• 2013-12-31: 586.13€ (WG 2), 1625.69€ (WG 5)
  
• 2014-05-05: 1203.43€ (WG 2), 565.94€ (WG 3), 749.22€ (WG 5)
• 2014-12-31: 643.37€ (WG 2), 1879.46€ (WG 5)
  
• 2015-12-31: 643.67€ (WG 2), 1869.94€ (WG 5)
  
• 2016-12-31: 569.61€ (WG 2), 1705.14€ (WG 5)
  
• 2018-06-23: 706.42€ (WG 2), 662.37€ (WG 5)
  
• 2018-12-31: 618.31€ (WG 2), 1668.12€ (WG 5)

Auch die Über- bzw. Gegenprüfung bestätigt dies: es gibt nur 339 nicht doppelte Fälle gibt.

Zusammenfassung der Erkenntnisse:

• Warengruppe 2 (Brötchen) ist mit großem Abstand die Warengruppe mit den meisten Ausreißern, diese sind in jedem Jahr überwiegend in der Sommerfereinzeit zu verzeichnen. Weitere Ausreißer gibt es in Warengruppe 5 (Kuchen). Die Ausreißer der WG 5 sind insbesondere an Silvester zu beobachten. Einen einzelnen Ausreißer gibt es in der WG 3 (Croissant) am 05.05.2014.
• Die Struktur der Verteilung der Ausreißer ist in allen Jahren ähnlich, hat jedoch gewisse Abweichungen in den einzelnen Jahren (vgl. bspw. die Verteilung der Ausreißer in den Jahren 2014 und 2017). Was die Anzahl Ausreißer insgesamt pro Jahr anbelangt, gibt es deutliche Schwankungen. Dies sollte ggf. bei den weitergehenden Analysen noch einmal gesondert berücksichtigt werden.
• Die Sommerferien (der Tourismus) scheinen einen signifikanten Einfluss auf den Umsatz zu haben; dies gilt nicht für die übrigen Ferien des Jahres. Allerdings scheint es ebenfalls entscheidend zu sein, wie die Sommerferien in den einzelnen Bundesländern liegen (starten die Fereien vglw. früh oder eher spät, gibt es Überschneidungen bei großen BuLä, wie lange dauern diese Überschneidungen an)
• Das Wochenende ist insgesamt ebenfalls ein bedeutender Einflussfaktor; dieser Effekt beschränkt sich jedoch zeitweise nur auf den Sonntag (je nach Jahreszeit).
• Die Kieler Woche beeinflusst die Umsätze der betrachteten Filiale in einzelnen Jahren des betrachteten Zeitraums maßgeblich, der Effekt ist jedoch nicht allzu groß.
• Feiertage haben nur teilweise einen bedeutsamen Einfluss auf den Umsatz (Ostern, Christi Himmelfahrt, Pfingsten, Tag der Deutschen Einheit, Silvester, nicht jedoch Weihnachten); andere Feiertage wie der Reformationstag haben keinen Einfluss.
• Die stärksten Ausreißer eines jeden der betrachteten Jahre sind jeweils an Silvester zu verzeichnen.

Als nächstes wird der Datensatz Wetter auf Ausreißer hin überprüft:

boxplot(Wetter$Bewoelkung)

boxplot(Wetter$Temperatur)

boxplot(Wetter$Windgeschwindigkeit)

boxplot(Wetter$Wettercode)

Nur die Variable Windgeschwindigkeit enthält 7 Ausreißer (Stürme).

2.7 Deskriptive Statistik

Wir werfen einen ersten Blick auf den Gesamtumsatz und den Mittelwert des Umsatzes je Warengruppe.

# tapply
tapply(Beispieldaten$Umsatz, Beispieldaten[,2], sum)

## Warengruppe
##         1         2         3         4         5         6 
## 272046.42 874857.56 364835.24 184680.16 605741.79  23386.15

tapply(Beispieldaten$Umsatz, Beispieldaten[,2], mean)

## Warengruppe
##         1         2         3         4         5         6 
## 125.13635 402.41838 167.81750  87.11328 278.63008  67.20159

Wir prüfen nun, wie viele Datensätze wir je Warengruppe vorfinden und über welchen Zeitraum sich die Datensätze erstrecken.

Beispieldaten %>%
  dplyr::select(Warengruppe) %>%
  group_by(Warengruppe) %>%
  summarise(n = n())

## # A tibble: 6 x 2
##   Warengruppe     n
##         <dbl> <int>
## 1           1  2174
## 2           2  2174
## 3           3  2174
## 4           4  2120
## 5           5  2174
## 6           6   348

Beispieldaten %>%
  group_by(Warengruppe) %>%
  summarise(min_dat=min(Datum), max_dat=max(Datum))

## # A tibble: 6 x 3
##   Warengruppe min_dat    max_dat   
##         <dbl> <date>     <date>    
## 1           1 2013-07-01 2019-07-30
## 2           2 2013-07-01 2019-07-30
## 3           3 2013-07-01 2019-07-30
## 4           4 2013-07-01 2019-07-30
## 5           5 2013-07-01 2019-07-30
## 6           6 2013-10-24 2018-12-28

Für die Warengruppen 1, 2, 3 und 5 gibt es jeweils 2.174 Datensätze, für die Warengruppe 4 sind es 2.120 Datensätze. Auffällig ist, dass es für die Warengruppe 6 nur 348 Datensätze gibt.

Die Datensätze für die ersten 5 Warengruppen erstrecken sich über denselben Zeitraum: 1.7.2013 bis 30.7.2019. Die erste Vermutung war, dass für die 6. Warengruppe nur ein eingeschränkter Zeitraum zur Verfügung steht. Dieser Verdacht wird widerlegt: Der Zeitraum der Daten für die 6. Warengruppe ist nur geringfügig kürzer und geht vom 24.10.2013 bis 28.12.2018.

Entscheidung: Die Warengruppe 6 wird in der Modellierung nicht betrachtet.

Beispieldaten %>%
  dplyr::select(Datum, Umsatz) %>%
  group_by(Datum) %>%
  summarise(Gesamtumsatz = sum(Umsatz)) %>%
  arrange(desc(Gesamtumsatz)) %>%
  top_n(20)

## Selecting by Gesamtumsatz

## # A tibble: 20 x 2
##    Datum      Gesamtumsatz
##    <date>            <dbl>
##  1 2014-05-05        3156.
##  2 2015-12-31        3015.
##  3 2014-12-31        2939.
##  4 2018-12-31        2805.
##  5 2016-12-31        2773.
##  6 2013-12-31        2615.
##  7 2017-12-31        2378.
##  8 2014-08-18        2121.
##  9 2014-06-28        2096.
## 10 2019-06-29        2035.
## 11 2013-08-03        2022.
## 12 2016-08-13        2014.
## 13 2014-08-24        1989.
## 14 2019-04-20        1988.
## 15 2018-06-23        1987.
## 16 2014-08-23        1975.
## 17 2014-08-09        1958.
## 18 2018-08-18        1950.
## 19 2017-04-15        1950.
## 20 2014-08-16        1934.

3.1 Umgang mit Ausreißern

Zwei der 7 verbleibenden Variablen enthalten Ausreißer: Umsatz und Windgeschwindigkeit. Beim Umgang mit den vorhandenen Ausreißern muss differenziert werden, ob es sich um unerwartete / nicht prognostizierbare Ausreißer handelt oder ob diese in gewisser Hinsicht planbar sind, weil sie erwartbar sind, da sie in allen Jahren gleichermaßen zu beobachten sind (z.B. Silvester). Prognostizierbare Ausreißer werden im weiteren Verlauf kodiert, d.h. es werden Variablen für diese planbaren Ausreißer angelegt.

Was die vorliegenden Daten anbelangt, sind einzig die Umsätze am Montag, 05.05.2014 auf den ersten Blick nicht zu erklären. Dieser Tag ist der umsatzstärkste Tag im gesamten Zeitverlauf. Zudem ist es der einzige Tag im gesamten Datensatz, bei dem es Ausreißer für drei Warengruppen gibt (ansonsten beschränken sich die Ausreißer weitestgehend auf Warengruppe 2, vereinzelt gibt es Tage, an denen auch Warengruppe 5 Ausreißer aufweist, z.B. an Silvester).

Bei genauerem Hinsehen haben wir festgestellt, dass für die beiden Vortage 03.05.2014 und 04.05.2014 keine Umsatzdaten vorliegen und zwar für alle Warengruppen. Der Verdacht liegt nahe, dass die Umsätze für den Zeitraum 03.-05.05.2014 summiert für den 05.05.2014 angesetzt wurden. Wir finden nämlich für den 05.05.2014 insgesamt einen Umsatz in Höhe von 3.156. Für den Vergleichszeitraum eine Woche später (10.-12.05.2014) finden wir einen Gesamtumsatz in vergleichbarer Höhe: 3.267. Es handelt sich bei keinem der Tage um einen Feiertag.

Wir korrigieren die Werte für den Zeitraum 03.-05.05.2014 und setzen dafür vereinfachend die Werte der Folgewoche ein. Wir erstellen einen Datensatz df als Kopie der Beispieldaten. Dann löschen wir zunächst den 05.05.2014, laden die korrigierten Werte für den 03.-05.05.2014 aus dem Datensatz Beispieldaten_Korrektur.csv und verknüpfen ihn mit df.

Beispieldaten %>% 
  group_by(Datum) %>% 
  filter(Datum=="2014-05-05") %>% 
  summarise(Summe_Umsatz=sum(Umsatz))

## # A tibble: 1 x 2
##   Datum      Summe_Umsatz
##   <date>            <dbl>
## 1 2014-05-05        3156.

Beispieldaten %>% 
  filter(Datum >= "2014-05-10" & Datum <= "2014-05-12") %>%
  group_by(Datum) %>%
  summarise(Summe_Umsatz=sum(Umsatz))

## # A tibble: 3 x 2
##   Datum      Summe_Umsatz
##   <date>            <dbl>
## 1 2014-05-10        1209.
## 2 2014-05-11        1192.
## 3 2014-05-12         867.

# erzeuge df vor Korrektur der Beispieldaten
df <- Beispieldaten

# entferne alte Werte für den 05.05.2014
df <- df %>% filter(Datum != "2014-05-05")

# lese korrigierte Datensätze ein und füge Attribut Jahr hinzu
Beispieldaten_korr <- read_csv("data/Beispieldaten_Korrektur.csv")

## Parsed with column specification:
## cols(
##   Datum = col_date(format = ""),
##   Warengruppe = col_double(),
##   Umsatz = col_double()
## )

Beispieldaten_korr <- Beispieldaten_korr %>% mutate(Jahr = year(Datum))

# verknüpfe df mit den korrigierten Datensätzen
df <- rbind(df, Beispieldaten_korr)
df %>% filter(Datum == "2014-05-05")

## # A tibble: 5 x 4
##   Datum      Warengruppe Umsatz  Jahr
##   <date>           <dbl>  <dbl> <dbl>
## 1 2014-05-05           1  118.   2014
## 2 2014-05-05           2  329.   2014
## 3 2014-05-05           3  124.   2014
## 4 2014-05-05           4   67.5  2014
## 5 2014-05-05           5  229.   2014

Da die anderen Ausreißer durch jeweilige Sondereffekte zu erklären sind (Wochenende, Feiertag, Brückentag etc.) werden diese Ausreißer im Datensatz belassen und im Fortgang hierfür gesonderte Variablen angelegt.

3.2 Umgang mit Warengruppe 6

Die Anzahl der Datensätze je Warengruppe differiert teilweise stark, insbesondere Warengruppe 6 ist auffällig:

• Warengruppen 1, 2, 3 und 5: jeweils 2.174 Datensätze
• Warengruppe 4: 2.120 Datensätze
• Warengruppe 6: 348 Datensätze.

Die Datensätze der Warengruppe 6 werden infolgedessen gelöscht:

df <- df %>%
  filter(Warengruppe != 6)

Nach dem Löschen der Datensätze enthält der Datensatz nunmehr 10826 Zeilen.

3.3 Rohdaten mit vollständiger Zeitreihe

Zunächst wird ein weiterer Datensatz df_voll erstellt, der eine komplette Zeitreihe enthält vom 1.7.2013 bis 31.7.2019 für alle Warengruppen 1 bis 5. Dabei wird in Kauf genommen, dass dieser zunächst viele fehlende Werte enthalten wird, die im weiteren Verlauf für die einzelnen Modelle sinnvoll zu ergänzen sind:

## Hinzufügen der vollständigen Zeitreihe
Zeitreihe_voll_WG <- read_csv2("data/Zeitreihe_voll_WG.csv")
df_voll <- left_join(Zeitreihe_voll_WG, df, by = c("Datum", "Warengruppe"))

3.4 Vereinigung der Datensätze

Bei der Untersuchung der Datumsvariablen der einzelnen Datensätze ergab sich, dass diese über unterschiedliche Zeiträume reichen:

• Die Daten des Datensatzes Beispieldaten reichen vom 01.07.2013 bis zum 30.07.2019, sind aber teilweise unvollständig. Es fehlen bspw. für alle Warengruppen Daten für den Tag der Arbeit, Weihnachten, Neuhjahr etc. Weiterhin fehlen insbesondere bei der Warengruppe 4 immer wieder einzelne Daten in den Sommermonaten, vereinzelt auch an einzelnen Tagen im Herbst.
• Die Daten des Datensatzes KiWo reichen vom 16.06.2012 bis zum 30.06.2019.
• Die Daten des Datensatzes Wetter reichen vom 01.01.2012 bis zum 01.08.2019.

Maßgeblich ist für uns der Zeitraum der vollstängien Zeitreihe df_voll vom 01.07.2013 bis zum 31.07.2019. Wir fügen über ein left_join die Daten zur Kieler Woche und die Wetterdaten an.

df_voll <- left_join(df_voll, KiWo, by = "Datum")
df_voll <- left_join(df_voll, Wetter, by = "Datum")
head(df_voll)

## # A tibble: 6 x 9
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013          NA          6       17.8
## 2 2013-07-01           2  536.   2013          NA          6       17.8
## 3 2013-07-01           3  201.   2013          NA          6       17.8
## 4 2013-07-01           4   65.9  2013          NA          6       17.8
## 5 2013-07-01           5  317.   2013          NA          6       17.8
## 6 2013-07-02           1  160.   2013          NA          3       17.3
## # ... with 2 more variables: Windgeschwindigkeit <dbl>, Wettercode <dbl>

3.5 Korrektur der Anzahl Nachkommastellen für einzelne Variablen

Die Variablen Umsatz und Temperatur enthalten jeweils vier Nachkommastellen, die als überflüssig und unsinnig erachtet werden. Die Anzahl der Nachkommstellen wird entsprechend korrigiert, wobei die Anzahl Nachkommastellen bei der Variable Umsatz auf 2 Nachkommastellen, die Variable Temperatur auf 1 Nachkommastelle gerundet wird:

df_voll <- df_voll %>%
  mutate(Umsatz = round(Umsatz, 2)) %>% 
  mutate(Temperatur = round(Temperatur, 1))
head(df_voll)

## # A tibble: 6 x 9
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013          NA          6       17.8
## 2 2013-07-01           2  536.   2013          NA          6       17.8
## 3 2013-07-01           3  201.   2013          NA          6       17.8
## 4 2013-07-01           4   65.9  2013          NA          6       17.8
## 5 2013-07-01           5  317.   2013          NA          6       17.8
## 6 2013-07-02           1  160.   2013          NA          3       17.3
## # ... with 2 more variables: Windgeschwindigkeit <dbl>, Wettercode <dbl>

3.6 Umgang mit fehlenden Werten

Der Datensatz KiWo enthält nur 72 Datensätze: für jedes Jahr wurde den Tagen, an denen die KiWo stattfindet, eine 1 zugeordnet. Diese Werte wurden Bei der Vereinigung der Datensätze entsprechend korrekt gemerged. Für alle anderen Daten, an denen keine KiWo ist, wurde bei der Vereinigung ein fehlender Wert (NA) automatisch erzeugt. Diese fehlenden Werte sind für die weitergehenden Analysen durch “0” zu ersetzen:

df_voll <- df_voll %>%
  mutate(KielerWoche = replace_na(KielerWoche, 0))
head(df_voll)

## # A tibble: 6 x 9
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013           0          6       17.8
## 2 2013-07-01           2  536.   2013           0          6       17.8
## 3 2013-07-01           3  201.   2013           0          6       17.8
## 4 2013-07-01           4   65.9  2013           0          6       17.8
## 5 2013-07-01           5  317.   2013           0          6       17.8
## 6 2013-07-02           1  160.   2013           0          3       17.3
## # ... with 2 more variables: Windgeschwindigkeit <dbl>, Wettercode <dbl>

Da die Variable Wettercode vglw. viele fehlende Werte hat (669) und unklar ist, wie diese fehlenden Werte sinnvoll ersetzt werden können, wird diese Variable ignoriert und eliminiert:

df_voll <- df_voll[,1:8]
head(df_voll)  

## # A tibble: 6 x 8
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-07-01           1  149.   2013           0          6       17.8
## 2 2013-07-01           2  536.   2013           0          6       17.8
## 3 2013-07-01           3  201.   2013           0          6       17.8
## 4 2013-07-01           4   65.9  2013           0          6       17.8
## 5 2013-07-01           5  317.   2013           0          6       17.8
## 6 2013-07-02           1  160.   2013           0          3       17.3
## # ... with 1 more variable: Windgeschwindigkeit <dbl>

3.7 Ergänzung um die Variablen Wochentag, Monat und Jahr

Ein wesentlicher Einflussfaktor für die Umsatzprognose wird der Wochentag sein, wir fügen diesen als eigene Spalte hinzu: Sonntag (1), Montag (2), … , Samstag (7). Und für die spätere Aufteilung der Daten in Training- und Testset wird das Jahr als weitere Spalte ergänzt und der Monat.

Damit die Wochentage adäquat in die späteren Modelle einfließen können, wird der Wochentag überdies als character-Variable abgespeichert.

Bsp.: Soll der Wochentag ein lineare Regressionsmodell aufgenommen werden, würde eine numerische Variable zu falschen Ergebnissen führen (wird der Wochentag um eins erhöht, erhöht sich der Umsatz um xy%). Bei einer character-Variable würde diese “dummyfiziert”. Ein Wochentag würde als Referenztag abgebildet werden und die anderen 6 Wochentage in Form von Dummyvariablen.

df_voll <- df_voll %>% mutate(Wochentag = wday(Datum))
df_voll <- df_voll %>% mutate(Jahr = year(Datum))
df_voll <- df_voll %>% mutate(Monat = month(Datum))

# Wochentag als character-Variable
df_voll <- df_voll %>% mutate(Wochentag_c = recode(Wochentag, "1" = "Sonntag", "2" = "Montag", "3" = "Dienstag", "4" = "Mittwoch", "5" = "Donnerstag", "6" = "Freitag", "7" = "Samstag"))

# Monat als character-Variable
df_voll <- df_voll %>% mutate(Monat_c = recode(Monat, "1" = "Januar", "2" = "Februar", "3" = "März", "4" = "April", "5" = "Mai", "6" = "Juni", "7" = "Juli", "8" = "August", "9" = "September", "10" = "Oktober", "11" = "November", "12" = "Dezember"))

Es besteht die Möglichkeit, dass es unterhalb der Wochentag keine großen Unterschiede gibt, wohl aber zwischen Wochentagen und Wochenendtagen. Insofern wird eine weitere Variable Wochenende erstellt, die nur die beiden Ausprägungen 1 = “Wochenende” und 0 = “kein Wochenende” (“Wochentag”) hat.

df_voll <- df_voll %>% mutate(Wochenende = recode(Wochentag, "1" = "1", "2" = "0", "3" = "0", "4" = "0", "5" = "0", "6" = "0", "7" = "1"))

df_voll <- df_voll %>% mutate(Wochenende = as.numeric(Wochenende))

3.8 Ergänzung um Sommerferienvariablen

Die Sommerferien scheinen einen starken Einfluss auf den Umsatz zu haben. Für die anderen Ferienzeiträume des Jahres gilt dies nicht. Für ausgewählte Bundesländer, namentlich Schleswig-Holstein, Nordrhein-Westfalen, Niedersachsen und Hessen wurden daher zunächst Datensätze in Excel erstellt (1 Datensatz je Bundesland). Diese Datensätze enthalten die Zeiträume der Sommerferien über die einzelnen Jahre. Diese Datensätze werden in R eingelesen und mit den anderen Daten zusammengeführt.

Die Auswahl der genannten Bundesländer erfolgte dabei anhand der Besucherzahlen / Übernachtungsvolumina in den vergangenen Jahren. Die meisten Gäste in Schleswig-Holstein kommen aus NRW, gefolgt von Niedersachsen und Schleswig-Holstein. Die Besucherzahlen aus Hessen lagen in den vergangenen Jahren etwas unterhalb derer von Niedersachsen und Schleswig-Holstein. Für Bayern und Baden-Württemberg werden zwar für die nähere Zukunft große Wachstumspotentiale prognostiziert, die Volumina waren in den betrachteten Zeiträumen jedoch gering und können daher vernachlässigt werden. Ebenso vernachlässigbar sind die übrigen Bundesländer.

## Ergänzung der Sommerferien Schleswig-Holstein
SoFeSH <- read_csv2("data/SoFe_SH.csv")  # da der Separator ein ";" ist, muss read_csv2 verwendet werden
df_voll <- left_join(df_voll, SoFeSH, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(SommerferienSH = replace_na(SommerferienSH, 0))


## Ergänzung der Sommerferien Nordrhein-Westfalen
SoFeNRW <- read_csv2("data/SoFe_NRW.csv") 
df_voll <- left_join(df_voll, SoFeNRW, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(SommerferienNRW = replace_na(SommerferienNRW, 0))

## Ergänzung der Sommerferien Niedersachsen
SoFeNDS <- read_csv2("data/SoFe_NDS.csv")  
df_voll <- left_join(df_voll, SoFeNDS, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(SommerferienNDS = replace_na(SommerferienNDS, 0))

# Ergänzung der Sommerferien Hessen
SoFeHE <- read_csv2("data/SoFe_HE.csv")  
df_voll <- left_join(df_voll, SoFeHE, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(SommerferienHE = replace_na(SommerferienHE, 0))

3.9 Ergänzung um Feiertagsvariablen

Die ersten Betrachtungen und Analysen lassen den Schluss zu, dass bestimmte Feiertage Einfluss auf die Höhe des Umsatzes haben.

Es existieren unterschiedliche Möglichkeiten, die Variable Feiertag für die Modellierung abzubilden / zu erfassen:

1. Anlegen einer generellen Feiertagsvariable: Feiertag ja/nein bzw. 1/0
2. Anlegen einer Variable für die einzelnen relevanten Feiertage.

Zu 1.: Begonnen wird mit der generellen Feiertagsvariable. Ausgewählte Feiertage (Karfreitag, Ostern, Christi Himmelfahrt, Pfingsten, Tag der Deutschen Einheit) werden daher zunächst in einer Excel-Datei gespeichert. Nach dem Einlesen der Datei werden die Daten zum Analysedatensatz hinzugefügt.

Feiertage <- read_csv2("data/Feiertage.csv")
df_voll <- left_join(df_voll, Feiertage, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Feiertag = replace_na(Feiertag, 0))

Zu 2.: Hier gibt es wiederum unterschiedliche Möglichkeiten. Zum einen kann man sich bei der Erstellung spezifischer Feiertagsvariablen, wie z. B. Ostern, rein auf die eigentlichen Feiertage beschränken, zum anderen könnten auch die Tage davor oder danach (Stichwort Brückentage, verlängertes Wochenende) in eine solche Feiertagsvariable einbezogen werden. Für die Feiertage Karfreitag/Ostern (ohne Karfreitag, da die Filiale an diesem Tag geschlossen ist und dementsprechend keine Daten verfügbar sind), Christi Himmelfahrt, Pfingsten, Tag der Deutschen Einheit und Silvester werden beide Varianten umgesetzt.

Zunächst werden Variablen erstellt, die nur die Feiertage enthalten:

## Hinzufügen der Variable Ostern (nur Feiertage Karfreitag, Ostersonntag, Ostermontag)
Ostern <- read_csv2("data/KarfreitagOstern.csv")
df_voll <- left_join(df_voll, Ostern, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Ostern = replace_na(Ostern, 0))


## Hinzufügen der Variable Christihimmmelfahrt (nur dieser Feiertag)
ChristiHimmelfahrt <- read_csv2("data/ChristiHimmelfahrt.csv")
df_voll <- left_join(df_voll, ChristiHimmelfahrt, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(ChristiHimmelfahrt = replace_na(ChristiHimmelfahrt, 0))


## Hinzufügen der Variable Pfingsten (nur Pfingstsonntag, Pfingstmontag)
Pfingsten <- read_csv2("data/Pfingsten.csv")
df_voll <- left_join(df_voll, Pfingsten, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Pfingsten = replace_na(Pfingsten, 0))


## Hinzufügen der Variable Tag der deutschen Einheit (nur der Feiertag)
TDE <- read_csv2("data/TdDE.csv")
df_voll <- left_join(df_voll, TDE, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(TDE = replace_na(TDE, 0))


## Hinzufügen der Variable Silvester
Silvester <- read_csv2("data/Silvester.csv")
df_voll <- left_join(df_voll, Silvester, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Silvester = replace_na(Silvester, 0))

In einem nächsten Schritt werden Variablen erstellt, die neben den Feiertagen auch “Brückentage” / den vorherigen oder darauffolgenden Tag enthalten. Bezüglich der Frage, welche umgebenden Tage im Speziellen berücksichtigt werden, wird auf die Umsätze der umgebenden Tage in der Vergangenheit referenziert. Sind diese signifikant / bedeutend höher als vergleichbare Wochentage, so werden diese mit einbezogen. Ausgenommen wird an dieser Stelle der Tag der Deutschen Einheit, da der Einfluss umgebender Tage bei diesem einzelnen Feiertag sehr davon abhängt, auf welchen Wochentag der Feiertag fällt.

## Hinzufügen der Variable Ostern_ext (= Ostern extendet) (Gründonnerstag, "Ostersamstag", Ostersonntag, Ostermontag, ohne Karfreitag, da geschlossen)
Ostern_ext <- read_csv2("data/Ostern_extended.csv")
df_voll <- left_join(df_voll, Ostern_ext, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Ostern_ext = replace_na(Ostern_ext, 0))


## Hinzufügen der Variable Christihimmmelfahrt (Mittwoch vor Himmelfahrt bis Sonntag nach Himmelfahrt) 
ChristiHimmelfahrt_ext <- read_csv2("data/ChristiHimmelfahrt_ext.csv")
df_voll <- left_join(df_voll, ChristiHimmelfahrt_ext, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(ChristiHimmelfahrt_ext = replace_na(ChristiHimmelfahrt_ext, 0))


## Hinzufügen der Variable Pfingsten_ext (Samstag vor Pfingsten/Pfingstssamstag, Pfingstsonntag, Pfingstmontag; Dienstag nch Pfingsten)
Pfingsten_ext <- read_csv2("data/Pfingsten_ext.csv")
df_voll <- left_join(df_voll, Pfingsten_ext, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Pfingsten_ext = replace_na(Pfingsten_ext, 0))



## Hinzufügen der Variable Silvester_ext (inkl. Vortag 30.12. und 01.01.)
Silvester_ext <- read_csv2("data/Silvester_ext.csv")
df_voll <- left_join(df_voll, Silvester_ext, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Silvester_ext = replace_na(Silvester_ext, 0))

3.10 Ergänzung um Variable Jahreszeit

Die ersten Betrachtungen und Analysen lassen darauf schließen, dass die Jahreszeiten einen Einfluss auf die Höhe des Umsatzes haben.

Die Variable Jahreszeiten kann bzw. muss dabei differenziert betrachtet werden. Zum einen besteht die Möglichkeit, Jahreszeiten als vorgegebene bzw. eigens definierte Variablen abzubilden. Dabei kann man bspw. den astronomische Eigenschaften zugrunde legen. Andererseits gibt es Modelle, die von sich heraus aus fiktive bzw. synthetische Jahreszeiten im Hintergrund ableiten.

Bsp.: Jahreszeiten können im Rahmen eines Entscheidungsbaums derart generiert werden, dass März, April, Mai zusammengefasst werden und zusätzlich aufgrund struktureller Ähnlichkeiten der September und der Oktober zu dieser (synthetischen) Jahreszeit hinzugefügt werden.

Die erste Möglichkeit soll an dieser Stelle umgesetzt werden. Die zweite Möglichkeit wird im weiteren Verlauf bei der Anwendung der unterschiedlichen Modelle relevant sein.

## Hinzufügen der Variable Jahreszeiten
Jahreszeiten <- read_csv2("data/Jahreszeiten.csv")
df_voll <- left_join(df_voll, Jahreszeiten, by = "Datum")

## Hinzufügen der Variable Fruehling
Fruehling <- read_csv2("data/Fruehling.csv")
df_voll <- left_join(df_voll, Fruehling, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Fruehling = replace_na(Fruehling, 0))


## Hinzufügen der Variable Sommer
Sommer <- read_csv2("data/Sommer.csv")
df_voll <- left_join(df_voll, Sommer, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Sommer = replace_na(Sommer, 0))


## Hinzufügen der Variable Herbst
Herbst <- read_csv2("data/Herbst.csv")
df_voll <- left_join(df_voll, Herbst, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Herbst = replace_na(Herbst, 0))


## Hinzufügen der Variable Winter
Winter <- read_csv2("data/Winter.csv")
df_voll <- left_join(df_voll, Winter, by = "Datum")

# Beim mergen erzeugte fehlende Werte (NA) durch 0 ersetzen:
df_voll <- df_voll %>%
  mutate(Winter = replace_na(Winter, 0))

3.11 vollständige Datenreihe, Imputationen, Trainingsdaten, Testdaten

# ergänze Attribut Umsatz_NA
df_voll <- df_voll %>% mutate(Umsatz_NA=is.na(Umsatz))

# Ergänze Spalten für den Umsatz vor 1 Woche (Umsatz_lag_1W), 2 Wochen (Umsatz_lag_2W), 3 Wochen (Umsatz_lag_3W) und 4 Wochen (Umsatz_lag_4W).
# WICHTIG: Pro Woche müssen wir 7*5=35 Datensätze zurück gehen (7 Tage mal 5 Warengruppen)
df_voll <- df_voll %>% mutate(Umsatz_lag_1W=lag(Umsatz,n=35))
df_voll <- df_voll %>% mutate(Umsatz_lag_2W=lag(Umsatz,n=2*35))
df_voll <- df_voll %>% mutate(Umsatz_lag_3W=lag(Umsatz,n=3*35))
df_voll <- df_voll %>% mutate(Umsatz_lag_4W=lag(Umsatz,n=4*35))

# Ergänze Attribut Umsatz_lag für den Vorwochen-Umsatz mit Initialwert 0.
df_voll <- df_voll %>% mutate(Umsatz_lag = 0)

# nicht Silvester / Neujahr: Dann nehme Umsatz der Vorwoche
df_voll <- df_voll %>% mutate(Umsatz_lag_temp = Umsatz_lag_1W * Umsatz_NA * !Silvester_ext)

# Zwischenschritt: ersetze NA durch 0
df_voll <- df_voll %>%
  mutate(Umsatz_lag_temp = replace_na(Umsatz_lag_temp, 0))

# Summiere Umsatz_lag und Umsatz_lag_temp
df_voll <- df_voll %>% mutate(Umsatz_lag = Umsatz_lag + Umsatz_lag_temp)

# Silvester / Neujahr: Dann nehme Umsatz von vor 4 Wochen
df_voll <- df_voll %>% mutate(Umsatz_lag_temp = Umsatz_lag_4W * Umsatz_NA * Silvester_ext)

# Zwischenschritt: ersetze NA durch 0
df_voll <- df_voll %>%
  mutate(Umsatz_lag_temp = replace_na(Umsatz_lag_temp, 0))

# Summiere Umsatz_lag und Umsatz_lag_temp
df_voll <- df_voll %>% mutate(Umsatz_lag = Umsatz_lag + Umsatz_lag_temp)

# prüfe: Wo fehlte noch Umsatz in den Rohdaten (Umsatz_NA = TRUE) den wir nicht ersetzen konnten aus Umsatz_lag_1W und Umsatz_lag_4W (Umsatz_lag = 0)? und Umsatz_lag = 0?
df_voll %>% filter(Umsatz_NA & (Umsatz_lag==0))

## # A tibble: 3 x 39
##   Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##   <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
## 1 2013-08-05           4     NA  2013           0          0       25.8
## 2 2014-12-25           4     NA  2014           0          7        3.1
## 3 2014-12-26           4     NA  2014           0          6        0  
## # ... with 32 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_lag_temp <dbl>

# Nehme für diese Fälle den Umsatz vor 2 Wochen (Umsatz_lag_2W)
df_voll <- df_voll %>% mutate(Umsatz_lag_temp = Umsatz_lag_2W * (df_voll$Umsatz_NA & df_voll$Umsatz_lag == 0))

# Zwischenschritt: ersetze NA durch 0
df_voll <- df_voll %>%
  mutate(Umsatz_lag_temp = replace_na(Umsatz_lag_temp, 0))

# Summiere Umsatz_lag und Umsatz_lag_temp
df_voll <- df_voll %>% mutate(Umsatz_lag = Umsatz_lag + Umsatz_lag_temp)

# prüfe: Wo fehlte noch Umsatz in den Rohdaten (Umsatz_NA = TRUE), der nicht ersetzt werden konnte (Umsatz_lag = 0)?
df_voll %>% filter(Umsatz_NA & (Umsatz_lag==0))

## # A tibble: 0 x 39
## # ... with 39 variables: Datum <date>, Warengruppe <dbl>, Umsatz <dbl>,
## #   Jahr <dbl>, KielerWoche <dbl>, Bewoelkung <dbl>, Temperatur <dbl>,
## #   Windgeschwindigkeit <dbl>, Wochentag <dbl>, Monat <dbl>,
## #   Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_lag_temp <dbl>

# Spalte Umsatz_lag_temp nicht mehr benötigt, entfernen!
df_voll <- df_voll[,1:38]

# Vorbereitung: ersetze in Spalte Umsatz NA durch 0
df_voll <- df_voll %>%
  mutate(Umsatz = replace_na(Umsatz, 0))

# Führe Umsatz und Umsatz_lag zusammen
df_voll <- df_voll %>% mutate(Umsatz = Umsatz + Umsatz_lag)

df_voll <- df_voll %>% arrange(Datum, Warengruppe)
df_train <- df_voll %>% filter(Jahr >= 2014 & Jahr <= 2017)
df_test <- df_voll %>% filter(Jahr == 2018)

# Export nach EXCEL
# df_voll <- df_voll %>% filter(Jahr >= 2014 & Jahr <= 2018)
# write_csv(df_voll, path="data/df_voll.csv", col_names=TRUE)

4.1 Umsatz je Wochentag / Warengruppe

Untersuche den Umsatz je Wochentag und/oder Warengruppe in den Daten. Als Basis verwenden wir die zunächst den vollständigen Datensatz df_voll.

df_voll %>% group_by(Warengruppe) %>% summarise(Umsatz_sum = sum(Umsatz))

## # A tibble: 5 x 2
##   Warengruppe Umsatz_sum
##         <dbl>      <dbl>
## 1           1    277596.
## 2           2    890675.
## 3           3    370967.
## 4           4    192355.
## 5           5    617014.

df_voll %>% group_by(Wochentag_c) %>% summarise(Umsatz_sum = sum(Umsatz))

## # A tibble: 7 x 2
##   Wochentag_c Umsatz_sum
##   <chr>            <dbl>
## 1 Dienstag       304703.
## 2 Donnerstag     315295.
## 3 Freitag        318081.
## 4 Mittwoch       303614 
## 5 Montag         313530.
## 6 Samstag        390812.
## 7 Sonntag        402571.

df_voll %>% group_by(Warengruppe, Wochentag_c) %>% summarise(Umsatz_sum = sum(Umsatz))

## # A tibble: 35 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Wochentag_c Umsatz_sum
##          <dbl> <chr>            <dbl>
##  1           1 Dienstag        38815.
##  2           1 Donnerstag      44083.
##  3           1 Freitag         41408.
##  4           1 Mittwoch        37845 
##  5           1 Montag          43193.
##  6           1 Samstag         47593.
##  7           1 Sonntag         24659.
##  8           2 Dienstag       112113.
##  9           2 Donnerstag     115419.
## 10           2 Freitag        117023.
## # ... with 25 more rows

df_voll %>% group_by(Warengruppe, Wochentag) %>% summarise(Umsatz_sum = sum(Umsatz))

## # A tibble: 35 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Wochentag Umsatz_sum
##          <dbl>     <dbl>      <dbl>
##  1           1         1     24659.
##  2           1         2     43193.
##  3           1         3     38815.
##  4           1         4     37845 
##  5           1         5     44083.
##  6           1         6     41408.
##  7           1         7     47593.
##  8           2         1    168796.
##  9           2         2    114975.
## 10           2         3    112113.
## # ... with 25 more rows

df_voll %>% group_by(Warengruppe, Wochenende) %>% summarise(Umsatz_sum = sum(Umsatz))

## # A tibble: 10 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Wochenende Umsatz_sum
##          <dbl>      <dbl>      <dbl>
##  1           1          0    205343.
##  2           1          1     72252.
##  3           2          0    570332.
##  4           2          1    320343.
##  5           3          0    236159.
##  6           3          1    134809.
##  7           4          0    123959.
##  8           4          1     68396.
##  9           5          0    419431.
## 10           5          1    197583.

• Warengruppe 2 zeigt den höchsten Umsatz insgesamt, gefolgt von Warengruppe 5.
• Die Wochentage Samstag und Sonntag sind mit leichtem Abstand die umsatzstärksten Tage, aggregiert über alle Warengruppen.
• Für die einzelnen Warengruppen zeigt sich ein differenzierteres Bild: Für Brot (Warengruppe 1) sind bspw. Donnerstag und Samstag die umsatzstärksten Wochentage. Auch der Montag ist in dieser Woche überdurchschnittlich stark im Vergleich zu den anderen Warengruppen.
• Vergleicht man die Wochenendumsätze mit den Umsätzen der Wochentag, so ergibt sich folgendes Bild:
  • 26% der Umsätze der Warengruppe 1 (Brot) werden am Wochenende erzielt, 74% an den Wochentagen
  • 36% der Umsätze der Warengruppe 2 (Brötchen) werden am Wochenende erzielt, 64% unter der Woche.
  • 37% der Umsätze der Warengruppe 3 (Croissants) werden am Wochenende erzielt, 63% an den Wochentagen.
  • 36% der Umsätze der Warengruppe 4 (Konditorei) werden am Wochenende erzielt, 64% unter der Woche.
  • 32% der Umsätze der Warengruppe 5 (Kuchen) werden am Wochenende erzielt, 68% unter der Woche. ==> demnach scheint es für die einzelnen Warengruppen abweichende Wochenend-Effekte geben. Kuchen und Brot werden im Verhältnis zu den anderen Warengruppen am Wochenende weniger verkauft.

4.2 Umsatz je Monat / Warengruppe

In einem weiteren Schritt werden die Umsätze je Warengruppe und Monat untersucht, um eine differenziertere Verteilung der Umsätze im Jahresverlauf zu erhalten.

df_voll %>% group_by(Warengruppe, Monat) %>% summarise(Umsatz_sum = sum(Umsatz))

## # A tibble: 60 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Monat Umsatz_sum
##          <dbl> <dbl>      <dbl>
##  1           1     1     20130.
##  2           1     2     18439.
##  3           1     3     22556.
##  4           1     4     23667.
##  5           1     5     22545 
##  6           1     6     24037.
##  7           1     7     31048.
##  8           1     8     27465.
##  9           1     9     22756.
## 10           1    10     22876.
## # ... with 50 more rows

df_voll %>% group_by(Warengruppe, Monat_c) %>% summarise(Umsatz_sum = sum(Umsatz)) %>% arrange(Warengruppe, desc(Umsatz_sum))

## # A tibble: 60 x 3
## # Groups:   Warengruppe [5]
##    Warengruppe Monat_c   Umsatz_sum
##          <dbl> <chr>          <dbl>
##  1           1 Juli          31048.
##  2           1 August        27465.
##  3           1 Juni          24037.
##  4           1 April         23667.
##  5           1 Oktober       22876.
##  6           1 September     22756.
##  7           1 März          22556.
##  8           1 Mai           22545 
##  9           1 Dezember      21791.
## 10           1 November      20284.
## # ... with 50 more rows

• Es gibt erkennbare Unterschiede zwischen den Warengruppen, was den Umsatz pro Monat anbelangt:
  • In den Warengruppen 1 - 3 (und mit Einschränkung Warengruppe 5) sind die Monate Juli, August und Juni die Top 3-Monate sind,
  • Bei Warengruppe 4 liegen diese Monate auf den Plätzen 3 (August), 6 (Juli) und 11 (Juni). In dieser Waregngruppe ist der Februar der umsatzstärkste Monat, gefolgt von Oktober, der bei den anderen WG eher im Mittelfeld liegt (Platz 4 - 6). Die Warengruppe 4 verhält sich bei der Verteilung der Umsätze im Monatsverlauf also deutlich anders als die anderen Warengruppen.
    
• Tendenziell sind die Umsätze in den Wintermonaten (Dezember, Januar, Februar) sowie im November am schwächsten (auch hier mit leichten Abweichungen bei Warengruppe 4 und 5). Die Warengruppen Konditorei und Kuchen unterscheiden sich hier, mal mehr mal weniger, von den ersten drei Warengruppen.

4.3 Umsatz im Zeitverlauf

Von Interesse ist nun die Entwicklung der Umsätze im Zeitverlauf. Wir wollen prüfen, ob eine Trendentwicklung zu beobachten ist und ob es strukturelle Brüche in den Zeitreihen gibt. Wir betrachten dafür zunächst die Entwicklung des Gesamtumsatzes pro Jahr. Als Datenbasis verwenden wir die Trainingsdaten df_train, die den Zeitraum 2014 bis 2017 umfassen und damit 4 Jahresscheiben abbilden.

umsatz_jahr <- df_train %>% group_by(Jahr) %>% summarise(Umsatz=sum(Umsatz))
umsatz_jahr

## # A tibble: 4 x 2
##    Jahr  Umsatz
##   <dbl>   <dbl>
## 1  2014 428295.
## 2  2015 378659 
## 3  2016 359157.
## 4  2017 356290.

Zu beobachten ist, dass der Jahresumsatz von 2014 bis 2016 sukzessive sinkt und dann 2017 stabil bleibt. Um diese Beobachtung besser zu verstehen, betrachten wir den Umsatz nun auf Monatsebene, immer noch aggregiert über alle Warengruppen.

umsatz_jahr_monat <- df_train %>% mutate(Jahr=as.character(Jahr)) %>% group_by(Jahr, Monat) %>% summarise(Umsatz=sum(Umsatz)) # Variable Jahr in character umgewandelt, damit im folgenden Plot eine diskrete Farbskala in der Legende gezeigt werden kann

p_umsatz_jahr_monat <- ggplot(data = umsatz_jahr_monat, aes(x = Monat, y = Umsatz)) +
  geom_point(aes(color = Jahr), size = 3, alpha = 0.5) +
  geom_line(aes(group = Jahr, color = Jahr)) + 
  scale_x_discrete(limits=c("1","2","3","4","5","6","7","8","9","10","11","12")) +
  xlab("Monat") + ylab("Umsatz") + 
  labs(color = "Jahr") +
  theme_classic() +
  ggtitle("Gesamtumsatz je Monat")

p_umsatz_jahr_monat

Beobachtungen:

• Die Jahre 2016 und 2017 sind weitestgehend ähnlich im Jahresverlauf.
• Die Umsätze im Jahr 2014 sind insgesamt offenbar parallel verschoben und systematisch höher jeden Monat.
• Und der Verlauf für 2015 ist ähnlich zu 2016 und 2017, nur in den ersten 3 Monaten des Jahres scheint der Umsatz 2015 systematisch höher zu liegen.

Um dies weiter zu analysieren, betrachten wir schließlich noch den Umsatz auf Monatsebene je Warengruppe, um eventuelle Unterschiede im Verhalten der einzelnen Warengruppen aufzudecken.

umsatz_jahr_monat_WG <- df_train %>% mutate(Jahr=as.character(Jahr)) %>% group_by(Jahr, Monat, Warengruppe) %>% summarise(Umsatz=sum(Umsatz)) # Variable Jahr in character umgewandelt, damit im folgenden Plot eine diskrete Farbskala in der Legende gezeigt werden kann

Erstellung der Variablen Umsatz auf Monatsebene Warengruppe 1

p_umsatz_jahr_monat_WG1 <- 
  umsatz_jahr_monat_WG %>% 
  filter(Warengruppe == 1) %>% 
  ggplot(aes(x = Monat, y = Umsatz)) +
  geom_point(aes(color = Jahr), size = 3, alpha = 0.5) +
  geom_line(aes(group = Jahr, color = Jahr)) + 
  scale_x_discrete(limits=c("1","2","3","4","5","6","7","8","9","10","11","12")) +
  xlab("Monat") + ylab("Umsatz") + 
  labs(color = "Jahr") +
  theme_classic() +
  ggtitle("Warengruppe 1: Umsatz je Monat")

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 2

p_umsatz_jahr_monat_WG2 <- 
  umsatz_jahr_monat_WG %>% 
  filter(Warengruppe == 2) %>% 
  ggplot(aes(x = Monat, y = Umsatz)) +
  geom_point(aes(color = Jahr), size = 3, alpha = 0.5) +
  geom_line(aes(group = Jahr, color = Jahr)) + 
  scale_x_discrete(limits=c("1","2","3","4","5","6","7","8","9","10","11","12")) +
  xlab("Monat") + ylab("Umsatz") + 
  labs(color = "Jahr") +
  theme_classic() +
  ggtitle("Warengruppe 2: Umsatz je Monat")

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 3

p_umsatz_jahr_monat_WG3 <- 
  umsatz_jahr_monat_WG %>% 
  filter(Warengruppe == 3) %>% 
  ggplot(aes(x = Monat, y = Umsatz)) +
  geom_point(aes(color = Jahr), size = 3, alpha = 0.5) +
  geom_line(aes(group = Jahr, color = Jahr)) + 
  scale_x_discrete(limits=c("1","2","3","4","5","6","7","8","9","10","11","12")) +
  xlab("Monat") + ylab("Umsatz") + 
  labs(color = "Jahr") +
  theme_classic() +
  ggtitle("Warengruppe 3: Umsatz je Monat")

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 4

p_umsatz_jahr_monat_WG4 <- 
  umsatz_jahr_monat_WG %>% 
  filter(Warengruppe == 4) %>% 
  ggplot(aes(x = Monat, y = Umsatz)) +
  geom_point(aes(color = Jahr), size = 3, alpha = 0.5) +
  geom_line(aes(group = Jahr, color = Jahr)) + 
  scale_x_discrete(limits=c("1","2","3","4","5","6","7","8","9","10","11","12")) +
  xlab("Monat") + ylab("Umsatz") + 
  labs(color = "Jahr") +
  theme_classic() +
  ggtitle("Warengruppe 4: Umsatz je Monat")

Erstellung des Plots zur Variablen Umsatz auf Monatsebene Warengruppe 5

p_umsatz_jahr_monat_WG5 <- 
  umsatz_jahr_monat_WG %>% 
  filter(Warengruppe == 5) %>% 
  ggplot(aes(x = Monat, y = Umsatz)) +
  geom_point(aes(color = Jahr), size = 3, alpha = 0.5) +
  geom_line(aes(group = Jahr, color = Jahr)) + 
  scale_x_discrete(limits=c("1","2","3","4","5","6","7","8","9","10","11","12")) +
  xlab("Monat") + ylab("Umsatz") + 
  labs(color = "Jahr") +
  theme_classic() +
  ggtitle("Warengruppe 5: Umsatz je Monat")

p_umsatz_jahr_monat_WG1

p_umsatz_jahr_monat_WG2

p_umsatz_jahr_monat_WG3

p_umsatz_jahr_monat_WG4

p_umsatz_jahr_monat_WG5

Beobachtungen:

• Für die Warengruppen 1, 2, 3 und 5 zeigen sich ähnliche Effekte: Die Umsätze 2014 liegen systematisch höher. Das setzt sich bis in die ersten 3 Monate des Jahres 2015 fort. Ab April 2015 sind die Verläufe ähnlich bis Ende 2017.
• Die Warengruppe 4 ist insgesamt die umsatzschwächste Gruppe. Die Monatsumsätze sind über die Jahre 2014 bis 2017 relativ ähnlich. Eine Ausnahme bildet der Februar 2017: Hier liegen die Umsätze deutlich unter den Umsätzen der übrigen Jahre. Dafür gibt es bislang keine Erklärung.

Für die weitere Entwicklung unserer Prognosemodelle könnte es daher sinnvoll sein, dass wir uns bei den Trainingsdaten auf den Zeitraum ab April 2015 bis 2017 beschränken und die Zeit davor außer Acht lassen. Und wir behalten im Hinterkopf, dass der Februar 2017 auffällig niedrige Umsätze aufweist.

5.1 Vorhaben

Wir wollen nun einige naive Modelle einsetzen, um die Umsätze je Warengruppe zu prognostizieren. Wir arbeiten dafür mit dem vollständigen Datensatz df_voll, der für jeden Tag und jede Warengruppe eine Zeile enthält. Fehlende Umsatzwerte in den Rohdaten sind durch die Vorwochenwerte ersetzt, weitere fehlenden Daten sind mit NA gefüllt.

Wir werden im folgenden verschiedene naive Prognosemodelle testen und vergleichen. Zuerst betrachten wir die Schätzung des Umsatzes auf Basis des Vorwochenwertes (Umsatz_lag_1W).

Im zweiten Teil betrachten wir die Schätzung mittels eines gleitenden Durchschnitts über die letzten 3 Tage (Umsatz_glDS_3T). Wir wissen bereits, dass der Umsatz am Wochenende systematisch höher ist, als unter der Woche. Daher erwarten wir, dass der gleitende Durchschnitt in der Form nur eingeschränkt geeignet ist, wahrscheinlich nur Für Donnerstag und Freitag. Als Erweiterung könnte man den Umsatz für Wochentage auf Basis des Durchschnitts der letzten drei Wochentage schätzen und den Umsatz für Wochenendtage auf Basis der letzten drei Wochenendtage (Umsatz_glDS_3T_erw), oder sogar auf Basis der letzten vier Wochentage bzw. Wochenendtage (Umsatz_glDS_4T_erw).

Und schließlich betrachten wir einen gewichteten Mittelwert der Vorwochen (Umsatz_gewMW_4W) als Schätzer. Hierbei gewichten wir den Wert der Vorwoche mit 50%, den Wert zwei Wochen zurück mit 25% und den Wert drei Wochen zurück mit 15% und den Wert vier Wochen zurück mit 10%.

Dann werfen wir einen Blick auf die Prognose-Güte:

• Anteil an zu hoch / zu niedrig geschätzten Umsätze, ggf. je Warengruppe und/oder Wochentag
• mittlere Abweichung, mittlere absolute Abweichung, mittlere quadratische Abweichung
• Standardabweichung, Verteilung der Abweichungen

Wir wollen die naiven Modelle in ihrer Prognose-Güte vergleichen. Weiterhin prüfen wir die Top10 stärksten Abweichungen nach oben und nach unten für die verschiedenen Modelle, um rauszufinden, ob es Tage gibt, für die mehrere oder sogar alle naiven Modelle versagen.

5.2 Datenaufbereitung

Wir arbeiten mit dem vollständigen Datensatz df_voll. Dieser enthält im Zeitraum 01.07.2013 bis 31.07.2019 eine Zeile für jedes Datum und jede Warengruppe. In den Rohdaten fehlende Umsätze sind auf Basis der Vorwochenwerte ergänzt worden. Die Zeilen mit ergänzten Umsätzen sind selektierbar über die Variable Umsatz_NA (= TRUE).

Zunächst benötigen wir Werte für folgende Attribute, die teilweise schon vorhanden sind und teilweise neu erstellt werden:

• Umsatz_lag_1W
• Umsatz_lag_2W
• Umsatz_lag_3W
• Umsatz_lag_4W
• Umsatz_gewMW_4W
• Umsatz_lag_1T bis Umsatz_lag_8T, Umsatz_lag_13T, Umsatz_lag_14T (1 bis 8, 13 und 14 Tage zurück)
• Umsatz_glDS_3T
• Umsatz_glDS_3T_erw
• Umsatz_glDS_4T_erw

Wir erstellen für diesen Abschnitt einen Analysedatensatz df_naiv auf Basis von df_voll.

# initialisiere Datensatz
df_naiv <- df_voll

# fülle Umsatz_lag_1W mit dem Vorwochenwert (also 7 Tage mal 5 Warengruppen zurück)
df_naiv <- df_naiv %>% mutate(Umsatz_lag_1W = lag(Umsatz, n=35))

# fülle entsprechend Umsatz_lag_2W, Umsatz_lag_3W, Umsatz_lag_4W
df_naiv <- df_naiv %>% mutate(Umsatz_lag_2W = lag(Umsatz, n=70))
df_naiv <- df_naiv %>% mutate(Umsatz_lag_3W = lag(Umsatz, n=105))
df_naiv <- df_naiv %>% mutate(Umsatz_lag_4W = lag(Umsatz, n=140))

# damit können wir bereits den gewichteten Mittelwert der letzten 4 Wochen erstellen
df_naiv <- df_naiv %>% mutate(Umsatz_gewMW_4W = 0.5*Umsatz_lag_1W + 0.25*Umsatz_lag_2W + 0.15*Umsatz_lag_3W + 0.1 * Umsatz_lag_4W)

# Bereite die Berechnung des gleitenden Durchschnitts der letzten 3 Tage vor.
# Für die Berechnung des erweiterten gleitenden Durchschnitts benötigen wir weitere Tage.
df_naiv <- df_naiv %>% mutate(Umsatz_lag_1T = lag(Umsatz, n=5)) # 1 Tag zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_2T = lag(Umsatz, n=10)) # 2 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_3T = lag(Umsatz, n=15)) # 3 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_4T = lag(Umsatz, n=20)) # 4 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_5T = lag(Umsatz, n=25)) # 5 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_6T = lag(Umsatz, n=30)) # 6 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_7T = lag(Umsatz, n=35)) # 7 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_8T = lag(Umsatz, n=40)) # 8 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_13T = lag(Umsatz, n=65)) # 13 Tage zurück
df_naiv <- df_naiv %>% mutate(Umsatz_lag_14T = lag(Umsatz, n=70)) # 14 Tage zurück

# nun können wir den gleitenden Durchschnitt der letzten 3 Tage erstellen
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T = (Umsatz_lag_1T + Umsatz_lag_2T + Umsatz_lag_3T) / 3)

# Dir Berechnung des erweiterten gleitenden Durchschnitt ist etwas aufwändiger: Hierfür wollen wir zuerst den Durchschnitt der letzten 3 Wochentage bzw. Wochenendtage ermitteln. Für einen Montag müssen wir also 3, 4 und 5 Tage zurück gehen, für einen Samstag 6, 7 und 13 Tage. Oder anders ausgedrückt: Der Umsatz 1 Tag zurück (Umsatz_lag_1T) fließt in die Berechnung des erweiterten Durchschnitts für die Tage Di, Mi, Do, Fr und So ein, also alle Tage außer Mo und Sa. Wir errechnen den erweiterten Durchschnitt scheibenweise:
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = 0) # initialisiere neue Variable

# speichere die 1. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_1T * (df_naiv$Wochentag_c != "Montag" & df_naiv$Wochentag_c != "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 2. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_2T * (df_naiv$Wochentag_c == "Mittwoch" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 3. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_3T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 4. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_4T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 5. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_5T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag" | df_naiv$Wochentag_c == "Mittwoch"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 6. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_6T * (df_naiv$Wochentag_c == "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 7. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_7T * (df_naiv$Wochentag_c == "Samstag" | df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 8. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_8T * (df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# speichere die 13. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_13T * (df_naiv$Wochentag_c == "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_3T_erw, mit Faktor 1/3
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_3T_erw = Umsatz_glDS_3T_erw + (Umsatz_temp / 3))

# Prüfung: df_naiv %>% filter(is.na(Umsatz_glDS_3T_erw))

# Wir wiederholen das Vorgehen, um noch den Durchschnitt der letzten 4 Wochentage bzw. Wochenendtage ermitteln. Für einen Montag müssen wir also 3, 4, 5 und 6 Tage zurück gehen, für einen Samstag 6, 7, 13 und 14 Tage. Oder anders ausgedrückt: Der Umsatz 1 Tag zurück (Umsatz_lag_1T) fließt in die Berechnung des erweiterten Durchschnitts für die Tage Di, Mi, Do, Fr und So ein, also alle Tage außer Mo und Sa. Wir errechnen den erweiterten Durchschnitt scheibenweise:
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = 0) # initialisiere neue Variable

# speichere die 1. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_1T * (df_naiv$Wochentag_c != "Montag" & df_naiv$Wochentag_c != "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 2. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_2T * (df_naiv$Wochentag_c == "Mittwoch" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 3. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_3T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Donnerstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 4. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_4T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag" | df_naiv$Wochentag_c == "Freitag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 5. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_5T * (df_naiv$Wochentag_c == "Montag" | df_naiv$Wochentag_c == "Dienstag" | df_naiv$Wochentag_c == "Mittwoch"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 6. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_1T * (df_naiv$Wochentag_c != "Freitag" & df_naiv$Wochentag_c != "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 7. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_7T * (df_naiv$Wochentag_c == "Samstag" | df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 8. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_8T * (df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 13. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_13T * (df_naiv$Wochentag_c == "Samstag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

# speichere die 14. Scheibe in Umsatz_temp zwischen
df_naiv <- df_naiv %>% mutate(Umsatz_temp = Umsatz_lag_14T * (df_naiv$Wochentag_c == "Samstag" | df_naiv$Wochentag_c == "Sonntag"))

# Zwischenschritt: ersetze NA durch 0
df_naiv <- df_naiv %>%
  mutate(Umsatz_temp = replace_na(Umsatz_temp, 0))

# übernehme das Zwischenergebnis in die Zielvariable Umsatz_glDS_4T_erw, mit Faktor 1/4
df_naiv <- df_naiv %>% mutate(Umsatz_glDS_4T_erw = Umsatz_glDS_4T_erw + (Umsatz_temp / 4))

Unsere Schätzung machen wir nur für Tage, für die Umsatzdaten in den Rohdaten vorlagen (Umsatz_NA = FALSE). Und für die einzelnen Modelle beginnt die Schätzung erst ab dem Zeitpunkt, ab dem Vorwochenwerte vorliegen. Für die Verwendung des gewichteten MIttelwertes der letzten 4 Wochen können wir bspw. erst ab dem 29. Tag schätzen. Alle anderen Schätzer liegen schon früher vor. Für die Vergleichbarkeit der Modelle starten wir daher einheitlich ab dem 01.08.2013 (also sogar erst 31 Tage nach Beginn der Zeitreihe).

5.3 Prognose der Umsätze anhand des Vorwochenwertes

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir einen eigenen Datensatz prog_naiv_lag_1W.

prog_naiv_lag_1W <- df_naiv %>%
  filter(Umsatz_NA == FALSE) %>% # fehlende Umsätze in den Rohdaten raus nehmen
  filter(Datum >= "2013-08-01")  # starte ab 01.08.2013
  
# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
prog_naiv_lag_1W <- prog_naiv_lag_1W %>%
  mutate(Prognose_zuhoch = (Umsatz_lag_1W >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_lag_1W - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_lag_1W - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_lag_1W - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Prognosegüte: Anteil "zu hoch prognostiziert". Ergänze dafür zunächst die Anzahl der Beobachtungen je Warengruppe (Anzahl), um danach den absoluten Anteil (Anteil_abs) und relativen Anteil (Anteil_rel) zu ermitteln.
prog_naiv_lag_1W <- prog_naiv_lag_1W %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

prog_naiv_lag_1W %>% 
  group_by(Warengruppe, Prognose_zuhoch) %>%
  summarise(Anteil_abs = n(), Anteil_rel = round(n() / mean(Anzahl) * 100))

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1059         49
##  2           1 TRUE                  1086         51
##  3           2 FALSE                 1054         49
##  4           2 TRUE                  1091         51
##  5           3 FALSE                 1061         49
##  6           3 TRUE                  1084         51
##  7           4 FALSE                 1023         49
##  8           4 TRUE                  1075         51
##  9           5 FALSE                 1060         49
## 10           5 TRUE                  1085         51

# Prognosegüte: mittlere Abweichung, Standardabweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung, das 5% und das 95% Quantil für die Abweichung
prog_naiv_lag_1W %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n(), mittlUmsatz=mean(Umsatz), mittlAbw=mean(Abweichung), StdAbw=sd(Abweichung), mittlAbw_abs=mean(Abweichung_abs), mittlAbw_rel=round(mean(Abweichung_abs)/mean(Umsatz)*100), mittlAbw_quad=sum(Abweichung_quad)/n(), Abweichung_Q5 = quantile(Abweichung,  probs = c(0.05)), Abweichung_Q95 = quantile(Abweichung,  probs = c(0.95)))

## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.0664   41.4         29.9           24
## 2           2   2145       399.    0.204    85.1         58.2           15
## 3           3   2145       166.   -0.0511   45.3         32.9           20
## 4           4   2098        87.2   0.0784   32.5         23.3           27
## 5           5   2145       277.    0.354   125.          53.3           19
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

# visualisiere die relative Abweichung im Histogramm: Erhalte eine Verteilung der Abweichung
naiv_lag_1W_relAbw_hist <- ggplot(data = prog_naiv_lag_1W, aes(x = Abweichung_rel*100)) + 
  geom_histogram(binwidth = 5, fill="steelblue", color="black", size=0.5) +
  ggtitle("Schätzung auf Basis der Vorwoche: Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Anzahl Beobachtungen")

# ermittle die Dichteverteilung für die Abweichung
naiv_lag_1W_relAbw_dens <- ggplot(data = prog_naiv_lag_1W, aes(x = Abweichung_rel*100)) + 
  geom_density(fill="steelblue", color="steelblue", size=0.5, alpha = 0.3) +
  ggtitle("Schätzung auf Basis der Vorwoche: Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte")

# zeige das Histogramm und die Dichteverteilung
naiv_lag_1W_relAbw_hist

naiv_lag_1W_relAbw_dens

Die Verteilung der relativen Abweichung erscheint sehr breit. Unser naiver Schätzer auf Basis des Vorwochenwertes liefert also keine gute Umsatzprognose. Augenscheinlich gibt es einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_lag_1W erstellt, mit dem wir jetzt weiter arbeiten.

# Untersuche die Fälle, in denen die Prognose mehr als 100% höher war als der Umsatz. Die Ausreißer verteilen sich folgendermaßen auf die Warengruuppen:
prog_naiv_lag_1W %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n())

## # A tibble: 5 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1     46
## 2           2     11
## 3           3     19
## 4           4     53
## 5           5      9

# Offenbar haben wir ein Problem für die Warengruppen 1 (Brot) und 4 (Konditorei), die wir näher betrachen wollen. Untersuche, ob Feiertage die Ursache sind:
prog_naiv_lag_1W %>%
  filter(Abweichung_rel > 1, Warengruppe == 1 | Warengruppe == 4) %>%
  group_by(Warengruppe, Feiertag) %>%
  summarise(Anzahl=n())

## # A tibble: 3 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     36
## 2           1        1     10
## 3           4        0     53

# Das liefert uns keine nennenswerten Erkenntnisse, Feiertage scheinen nicht die Hauptursache für die starken Abweichungen zu sein. Untersuche, ob einzelne Wochentage besonders betroffen sind, jetzt wieder über alle Warengruppen:
prog_naiv_lag_1W %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Wochentag_c) %>%
  summarise(Anzahl=n())

## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         7
## 2 Donnerstag      25
## 3 Freitag          8
## 4 Mittwoch        20
## 5 Montag          33
## 6 Samstag         25
## 7 Sonntag         20

Für Dienstage und Freitage scheint unser naiver Schätzer nur selten eine deutlich zu hohe Prognose zu liefern. Ansonsten sind keine Unterschiede zu erkennen.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

# sortiere nach der relativen Abweichung und zeige die ersten und letzten 10 Zeilen
prog_naiv_lag_1W %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2016-12-31           5 1705.   2016           0          7        4.9
##  2 2017-12-31           5 1432.   2017           0          7        8.2
##  3 2014-12-31           5 1879.   2014           0          6        7.4
##  4 2015-12-31           5 1870.   2015           0          7        2  
##  5 2013-12-31           5 1626.   2013           0          4        5  
##  6 2016-02-04           4  213.   2016           0          5        4.2
##  7 2018-12-31           5 1668.   2018           0          7        7.4
##  8 2017-04-24           1   92.5  2017           0          7        8.9
##  9 2017-05-25           4  179.   2017           0          2       18.9
## 10 2016-05-16           4  221.   2016           0          5       11.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_lag_1W %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2014-03-02           4  108.   2014           0          6        6.6
##  2 2017-01-07           1   71.7  2017           0          8       -0.5
##  3 2018-01-07           5  316.   2018           0          0        0.6
##  4 2017-04-22           1   81.4  2017           0          5        7.5
##  5 2017-01-07           5  266.   2017           0          8       -0.5
##  6 2019-01-07           5  250.   2019           0          8        5.9
##  7 2017-04-17           1   23.2  2017           0          6        6.2
##  8 2015-01-07           5  263.   2015           0          6        5.8
##  9 2014-01-07           5  211.   2014           0          7       10.4
## 10 2016-01-07           5  212.   2016           0          7       -4  
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des Vorwochenwertes offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Ebenso liefert das Modell für den 7. Januar konsequent zu hohe Schätzwerte, weil diese auf Basis der sehr hohen Silvester-Umsätze prognostiziert werden.

5.4 Prognose der Umsätze anhand des gleitenden Durchschnitts

In diesem Abschnitt betrachten wir die Schätzung mittels eines gleitenden Durchschnitts über die letzten 3 Tage (Umsatz_glDS_3T). Wir wissen bereits, dass der Umsatz am Wochenende systematisch höher ist, als unter der Woche. Daher erwarten wir, dass der gleitende Durchschnitt in der Form nur eingeschränkt geeignet ist, wahrscheinlich nur Für Donnerstag und Freitag.

Als Erweiterung wollen wir den Umsatz für Wochentage auf Basis des Durchschnitts der letzten drei Wochentage schätzen und den Umsatz für Wochenendtage auf Basis der letzten drei Wochenendtage (Umsatz_glDS_3T_erw). Und am Ende erweitern wir dieses Vorgehen sogar noch um einen Tag (Umsatz_glDS_4T_erw) und beziehen die letzten vier Wochen- bzw. Wochenendtage in die Prognose ein.

prog_naiv_glDS_3T <- df_naiv %>%
  filter(Umsatz_NA == FALSE) %>% # fehlende Umsätze in den Rohdaten raus nehmen
  filter(Datum >= "2013-08-01")  # starte ab 01.08.2013
  
# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
prog_naiv_glDS_3T <- prog_naiv_glDS_3T %>%
  mutate(Prognose_zuhoch = (Umsatz_glDS_3T >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_glDS_3T - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_glDS_3T - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_glDS_3T - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Prognosegüte: Anteil "zu hoch prognostiziert". Ergänze dafür zunächst die Anzahl der Beobachtungen je Warengruppe (Anzahl), um danach den absoluten Anteil (Anteil_abs) und relativen Anteil (Anteil_rel) zu ermitteln.
prog_naiv_glDS_3T <- prog_naiv_glDS_3T %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

prog_naiv_glDS_3T %>% 
  group_by(Warengruppe, Prognose_zuhoch) %>%
  summarise(Anteil_abs = n(), Anteil_rel = round(n() / mean(Anzahl) * 100))

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1183         55
##  2           1 TRUE                   962         45
##  3           2 FALSE                 1047         49
##  4           2 TRUE                  1098         51
##  5           3 FALSE                 1008         47
##  6           3 TRUE                  1137         53
##  7           4 FALSE                  938         45
##  8           4 TRUE                  1160         55
##  9           5 FALSE                 1065         50
## 10           5 TRUE                  1080         50

# Prognosegüte: mittlere Abweichung, Standardabweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung, das 5% und das 95% Quantil für die Abweichung
prog_naiv_glDS_3T %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n(), mittlUmsatz=mean(Umsatz), mittlAbw=mean(Abweichung), StdAbw=sd(Abweichung), mittlAbw_abs=mean(Abweichung_abs), mittlAbw_rel=round(mean(Abweichung_abs)/mean(Umsatz)*100), mittlAbw_quad=sum(Abweichung_quad)/n(), Abweichung_Q5 = quantile(Abweichung,  probs = c(0.05)), Abweichung_Q95 = quantile(Abweichung,  probs = c(0.95)))

## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.    -0.755   41.8         30.6           25
## 2           2   2145       399.    -1.99   108.          86.2           22
## 3           3   2145       166.    -0.767   51.6         39.8           24
## 4           4   2098        87.2   -0.197   36.6         26.0           30
## 5           5   2145       277.    -2.05    99.2         49.0           18
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

# visualisiere die relative Abweichung im Histogramm: Erhalte eine Verteilung der Abweichung
naiv_glDS_3T_relAbw_hist <- ggplot(data = prog_naiv_glDS_3T, aes(x = Abweichung_rel*100)) + 
  geom_histogram(binwidth = 5, fill="red", color="black", size=0.5) +
  ggtitle("Schätzung auf Basis des gl. Durchschnitts (3 Tage): Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Anzahl Beobachtungen")
  
# ermittle die Dichteverteilung für die Abweichung
naiv_glDS_3T_relAbw_dens <- ggplot(data = prog_naiv_glDS_3T, aes(x = Abweichung_rel*100)) + 
  geom_density(fill="red", color="red", size=0.5, alpha = 0.3) +
  ggtitle("Schätzung auf Basis der gl. Durchschnitts (3 Tage): Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte")

# zeige das Histogramm und die Dichteverteilung
naiv_glDS_3T_relAbw_hist

naiv_glDS_3T_relAbw_dens

# Untersuche die Fälle, in denen die Prognose mehr als 100% höher war als der Umsatz. Die Ausreißer verteilen sich folgendermaßen auf die Warengruuppen:
prog_naiv_glDS_3T %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n())

## # A tibble: 5 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1    132
## 2           2      1
## 3           3     19
## 4           4     60
## 5           5     14

# Offenbar haben wir ein Problem für die Warengruppen 1 (Brot) und 4 (Konditorei), die wir näher betrachen wollen. Untersuche, ob Feiertage die Ursache sind:
prog_naiv_glDS_3T %>%
  filter(Abweichung_rel > 1, Warengruppe == 1 | Warengruppe == 4) %>%
  group_by(Warengruppe, Feiertag) %>%
  summarise(Anzahl=n())

## # A tibble: 4 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0    113
## 2           1        1     19
## 3           4        0     59
## 4           4        1      1

# Das liefert uns keine nennenswerten Erkenntnisse, Feiertage scheinen nicht die Hauptursache für die starken Abweichungen zu sein. Untersuche, ob einzelne Wochentage besonders betroffen sind, jetzt wieder über alle Warengruppen:
prog_naiv_glDS_3T %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Wochentag_c) %>%
  summarise(Anzahl=n())

## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag        26
## 2 Donnerstag       8
## 3 Freitag          5
## 4 Mittwoch        23
## 5 Montag          38
## 6 Samstag          7
## 7 Sonntag        119

# sortiere nach der relativen Abweichung und zeige die ersten und letzten 10 Zeilen
prog_naiv_glDS_3T %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2014-12-31           5  1879.  2014           0          6        7.4
##  3 2016-12-31           5  1705.  2016           0          7        4.9
##  4 2013-12-31           5  1626.  2013           0          4        5  
##  5 2018-12-31           5  1668.  2018           0          7        7.4
##  6 2017-12-31           5  1432.  2017           0          7        8.2
##  7 2013-11-17           4   177.  2013           0          2        8.9
##  8 2014-02-23           4   430.  2014           0          1        8.6
##  9 2015-02-01           4   215.  2015           0          7       -0.2
## 10 2017-01-15           4   230.  2017           0          5        1.4
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_glDS_3T %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-04-19           1   25.5  2015           0          0       10.1
##  2 2017-01-17           4   37.2  2017           0          7        0.5
##  3 2014-02-24           4   57.8  2014           0          1        9.4
##  4 2014-04-20           1   57.8  2014           0          0       13.9
##  5 2016-01-03           5  190.   2016           0          7       -5.5
##  6 2015-11-22           1   24.8  2015           0          7        2.2
##  7 2018-04-01           1   68.3  2018           0          6        2.5
##  8 2018-04-02           1   43.2  2018           0          5        6.1
##  9 2015-10-18           1   23.1  2015           0          8       11.1
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_glDS_3T_erw <- df_naiv %>%
  filter(Umsatz_NA == FALSE) %>% # fehlende Umsätze in den Rohdaten raus nehmen
  filter(Datum >= "2013-08-01")  # starte ab 01.08.2013
  
# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
prog_naiv_glDS_3T_erw <- prog_naiv_glDS_3T_erw %>%
  mutate(Prognose_zuhoch = (Umsatz_glDS_3T_erw >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_glDS_3T_erw - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_glDS_3T_erw - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_glDS_3T_erw - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Prognosegüte: Anteil "zu hoch prognostiziert". Ergänze dafür zunächst die Anzahl der Beobachtungen je Warengruppe (Anzahl), um danach den absoluten Anteil (Anteil_abs) und relativen Anteil (Anteil_rel) zu ermitteln.
prog_naiv_glDS_3T_erw <- prog_naiv_glDS_3T_erw %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

prog_naiv_glDS_3T_erw %>% 
  group_by(Warengruppe, Prognose_zuhoch) %>%
  summarise(Anteil_abs = n(), Anteil_rel = round(n() / mean(Anzahl) * 100))

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1061         49
##  2           1 TRUE                  1084         51
##  3           2 FALSE                 1066         50
##  4           2 TRUE                  1079         50
##  5           3 FALSE                 1058         49
##  6           3 TRUE                  1087         51
##  7           4 FALSE                  996         47
##  8           4 TRUE                  1102         53
##  9           5 FALSE                 1052         49
## 10           5 TRUE                  1093         51

# Prognosegüte: mittlere Abweichung, Standardabweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung, das 5% und das 95% Quantil für die Abweichung
prog_naiv_glDS_3T_erw %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n(), mittlUmsatz=mean(Umsatz), mittlAbw=mean(Abweichung), StdAbw=sd(Abweichung), mittlAbw_abs=mean(Abweichung_abs), mittlAbw_rel=round(mean(Abweichung_abs)/mean(Umsatz)*100), mittlAbw_quad=sum(Abweichung_quad)/n(), Abweichung_Q5 = quantile(Abweichung,  probs = c(0.05)), Abweichung_Q95 = quantile(Abweichung,  probs = c(0.95)))

## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.720    43.5         32.2           26
## 2           2   2145       399.   -1.34     69.2         48.2           12
## 3           3   2145       166.   -0.510    35.5         25.5           15
## 4           4   2098        87.2  -0.0883   31.7         22.4           26
## 5           5   2145       277.   -1.53     97.4         43.5           16
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

# visualisiere die relative Abweichung im Histogramm: Erhalte eine Verteilung der Abweichung
naiv_glDS_3T_erw_relAbw_hist <- ggplot(data = prog_naiv_glDS_3T_erw, aes(x = Abweichung_rel*100)) + 
  geom_histogram(binwidth = 5, fill="yellow", color="black", size=0.5) +
  ggtitle("Schätzung auf Basis des erw. gl. Durchschnitts (3 Wochen-/Wochenendtage): Rel. Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Anzahl Beobachtungen")
  
# ermittle die Dichteverteilung für die Abweichung
naiv_glDS_3T_erw_relAbw_dens <- ggplot(data = prog_naiv_glDS_3T_erw, aes(x = Abweichung_rel*100)) + 
  geom_density(fill="yellow", color="yellow", size=0.5, alpha = 0.3) +
  ggtitle("Schätzung auf Basis der erw. gl. Durchschnitts (3 Wochen-/Wochenendtage): Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte")

# zeige das Histogramm und die Dichteverteilung
naiv_glDS_3T_erw_relAbw_hist

naiv_glDS_3T_erw_relAbw_dens

# Untersuche die Fälle, in denen die Prognose mehr als 100% höher war als der Umsatz. Die Ausreißer verteilen sich folgendermaßen auf die Warengruuppen:
prog_naiv_glDS_3T_erw %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n())

## # A tibble: 4 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1    107
## 2           3      4
## 3           4     42
## 4           5     14

# Offenbar haben wir ein Problem für die Warengruppen 1 (Brot) und 4 (Konditorei), die wir näher betrachen wollen. Warengruppe 2 (Brötchen) taucht gar nicht auf. Untersuche, ob Feiertage die Ursache sind:
prog_naiv_glDS_3T_erw %>%
  filter(Abweichung_rel > 1, Warengruppe == 1 | Warengruppe == 4) %>%
  group_by(Warengruppe, Feiertag) %>%
  summarise(Anzahl=n())

## # A tibble: 4 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     90
## 2           1        1     17
## 3           4        0     41
## 4           4        1      1

# Für die Warengruppe 1 (Brot) spielen Feiertage bei den größeren Ausreißern eine Rolle. Das alleine liefert uns aber keine nennenswerten Erkenntnisse. Untersuche, ob einzelne Wochentage besonders betroffen sind, jetzt wieder über alle Warengruppen:
prog_naiv_glDS_3T_erw %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Wochentag_c) %>%
  summarise(Anzahl=n())

## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         8
## 2 Donnerstag       8
## 3 Freitag          5
## 4 Mittwoch         7
## 5 Montag          11
## 6 Samstag         37
## 7 Sonntag         91

# sortiere nach der relativen Abweichung und zeige die ersten und letzten 10 Zeilen
prog_naiv_glDS_3T_erw %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2018-12-31           5  1668.  2018           0          7        7.4
##  3 2016-12-31           5  1705.  2016           0          7        4.9
##  4 2014-12-31           5  1879.  2014           0          6        7.4
##  5 2013-12-31           5  1626.  2013           0          4        5  
##  6 2017-12-31           5  1432.  2017           0          7        8.2
##  7 2016-05-16           4   221.  2016           0          5       11.2
##  8 2017-04-15           1   396.  2017           0          6        8.1
##  9 2018-03-31           1   417.  2018           0          7        2.2
## 10 2019-04-20           1   382.  2019           0          0       13.1
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_glDS_3T_erw %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2017-04-23           1   54.2  2017           0          4        7.9
##  2 2015-11-22           1   24.8  2015           0          7        2.2
##  3 2017-01-08           5  206.   2017           0          8        2.2
##  4 2014-04-20           1   57.8  2014           0          0       13.9
##  5 2015-04-19           1   25.5  2015           0          0       10.1
##  6 2016-01-04           5  190.   2016           0          5       -6  
##  7 2015-04-12           1   39.0  2015           0          5       12.4
##  8 2018-04-02           1   43.2  2018           0          5        6.1
##  9 2015-10-18           1   23.1  2015           0          8       11.1
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_glDS_4T_erw <- df_naiv %>%
  filter(Umsatz_NA == FALSE) %>% # fehlende Umsätze in den Rohdaten raus nehmen
  filter(Datum >= "2013-08-01")  # starte ab 01.08.2013
  
# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
prog_naiv_glDS_4T_erw <- prog_naiv_glDS_4T_erw %>%
  mutate(Prognose_zuhoch = (Umsatz_glDS_4T_erw >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_glDS_4T_erw - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_glDS_4T_erw - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_glDS_4T_erw - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Prognosegüte: Anteil "zu hoch prognostiziert". Ergänze dafür zunächst die Anzahl der Beobachtungen je Warengruppe (Anzahl), um danach den absoluten Anteil (Anteil_abs) und relativen Anteil (Anteil_rel) zu ermitteln.
prog_naiv_glDS_4T_erw <- prog_naiv_glDS_4T_erw %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

prog_naiv_glDS_4T_erw %>% 
  group_by(Warengruppe, Prognose_zuhoch) %>%
  summarise(Anteil_abs = n(), Anteil_rel = round(n() / mean(Anzahl) * 100))

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1067         50
##  2           1 TRUE                  1078         50
##  3           2 FALSE                 1038         48
##  4           2 TRUE                  1107         52
##  5           3 FALSE                 1025         48
##  6           3 TRUE                  1120         52
##  7           4 FALSE                  980         47
##  8           4 TRUE                  1118         53
##  9           5 FALSE                 1036         48
## 10           5 TRUE                  1109         52

# Prognosegüte: mittlere Abweichung, Standardabweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung, das 5% und das 95% Quantil für die Abweichung
prog_naiv_glDS_4T_erw %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n(), mittlUmsatz=mean(Umsatz), mittlAbw=mean(Abweichung), StdAbw=sd(Abweichung), mittlAbw_abs=mean(Abweichung_abs), mittlAbw_rel=round(mean(Abweichung_abs)/mean(Umsatz)*100), mittlAbw_quad=sum(Abweichung_quad)/n(), Abweichung_Q5 = quantile(Abweichung,  probs = c(0.05)), Abweichung_Q95 = quantile(Abweichung,  probs = c(0.95)))

## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.831    38.0         28.4           23
## 2           2   2145       399.   -1.58     64.5         46.0           12
## 3           3   2145       166.   -0.451    34.1         24.5           15
## 4           4   2098        87.2   0.0940   28.3         20.5           23
## 5           5   2145       277.   -2.31     93.0         42.2           15
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

# visualisiere die relative Abweichung im Histogramm: Erhalte eine Verteilung der Abweichung
naiv_glDS_4T_erw_relAbw_hist <- ggplot(data = prog_naiv_glDS_4T_erw, aes(x = Abweichung_rel*100)) + 
  geom_histogram(binwidth = 5, fill="orange", color="black", size=0.5) +
  ggtitle("Schätzung auf Basis des erw. gl. Durchschnitts (4 Wochen-/Wochenendtage): Rel. Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Anzahl Beobachtungen")
  
# ermittle die Dichteverteilung für die Abweichung
naiv_glDS_4T_erw_relAbw_dens <- ggplot(data = prog_naiv_glDS_4T_erw, aes(x = Abweichung_rel*100)) + 
  geom_density(fill="orange", color="orange", size=0.5, alpha = 0.3) +
  ggtitle("Schätzung auf Basis der erw. gl. Durchschnitts (4 Wochen-/Wochenendtage): Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte")

# zeige das Histogramm und die Dichteverteilung
naiv_glDS_4T_erw_relAbw_hist

naiv_glDS_4T_erw_relAbw_dens

# Untersuche die Fälle, in denen die Prognose mehr als 100% höher war als der Umsatz. Die Ausreißer verteilen sich folgendermaßen auf die Warengruuppen:
prog_naiv_glDS_4T_erw %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n())

## # A tibble: 4 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1     75
## 2           3      4
## 3           4     32
## 4           5     12

# Offenbar haben wir ein Problem für die Warengruppen 1 (Brot) und 4 (Konditorei), die wir näher betrachen wollen. Warengruppe 2 (Brötchen) taucht gar nicht auf. Untersuche, ob Feiertage die Ursache sind:
prog_naiv_glDS_4T_erw %>%
  filter(Abweichung_rel > 1, Warengruppe == 1 | Warengruppe == 4) %>%
  group_by(Warengruppe, Feiertag) %>%
  summarise(Anzahl=n())

## # A tibble: 3 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     58
## 2           1        1     17
## 3           4        0     32

# Für die Warengruppe 1 (Brot) spielen Feiertage bei den größeren Ausreißern eine Rolle. Das alleine liefert uns aber keine nennenswerten Erkenntnisse. Untersuche, ob einzelne Wochentage besonders betroffen sind, jetzt wieder über alle Warengruppen:
prog_naiv_glDS_4T_erw %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Wochentag_c) %>%
  summarise(Anzahl=n())

## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         9
## 2 Donnerstag       6
## 3 Freitag          6
## 4 Mittwoch         7
## 5 Montag          19
## 6 Samstag         17
## 7 Sonntag         59

# sortiere nach der relativen Abweichung und zeige die ersten und letzten 10 Zeilen
prog_naiv_glDS_4T_erw %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2016-12-31           5  1705.  2016           0          7        4.9
##  3 2018-12-31           5  1668.  2018           0          7        7.4
##  4 2014-12-31           5  1879.  2014           0          6        7.4
##  5 2017-12-31           5  1432.  2017           0          7        8.2
##  6 2013-12-31           5  1626.  2013           0          4        5  
##  7 2017-05-25           4   179.  2017           0          2       18.9
##  8 2016-12-29           1   282.  2016           0          3        3.8
##  9 2016-05-16           4   221.  2016           0          5       11.2
## 10 2018-03-31           1   417.  2018           0          7        2.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_glDS_4T_erw %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2014-04-20           1   57.8  2014           0          0       13.9
##  2 2014-09-07           1   49.0  2014           0          5       20  
##  3 2014-02-24           4   57.8  2014           0          1        9.4
##  4 2016-01-04           5  190.   2016           0          5       -6  
##  5 2015-11-22           1   24.8  2015           0          7        2.2
##  6 2015-04-12           1   39.0  2015           0          5       12.4
##  7 2015-04-19           1   25.5  2015           0          0       10.1
##  8 2018-04-02           1   43.2  2018           0          5        6.1
##  9 2015-10-18           1   23.1  2015           0          8       11.1
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

5.5 Prognose der Umsätze anhand des gewichteten Vorwochendurchschnitts

Nun betrachten wir einen gewichteten Mittelwert der Vorwochen (Umsatz_gewMW_4W) als Schätzer. Hierbei gewichten wir den Wert der Vorwoche mit 50%, den Wert zwei Wochen zurück mit 25% und den Wert drei Wochen zurück mit 15% und den Wert vier Wochen zurück mit 10%.

Für die Schätzung und die anschließende Ermittlung der Gütemaße verwenden wir einen eigenen Datensatz prog_naiv_gewMW_4W. Wir starten wieder am 01.08.2013, um die Vergleichbarkeit der naiven Modelle zu wahren.

prog_naiv_gewMW_4W <- df_naiv %>%
  filter(Umsatz_NA == FALSE) %>% # fehlende Umsätze in den Rohdaten raus nehmen
  filter(Datum >= "2013-08-01")  # starte ab 01.08.2013
  
# ergänze Prognose_zuhoch (TRUE / FALSE), Abweichung (Schätzer - Umsatz), absolute Abweichung (Abweichung_abs), relative Abweichung (Abweichung_rel), quadratische Abweichung (Abweichung_quad)
prog_naiv_gewMW_4W <- prog_naiv_gewMW_4W %>%
  mutate(Prognose_zuhoch = (Umsatz_gewMW_4W >= Umsatz)) %>%
  mutate(Abweichung = Umsatz_gewMW_4W - Umsatz) %>%
  mutate(Abweichung_abs = abs(Umsatz_gewMW_4W - Umsatz)) %>%
  mutate(Abweichung_rel = (Umsatz_gewMW_4W - Umsatz) / Umsatz) %>%
  mutate(Abweichung_quad = Abweichung^2)

# Prognosegüte: Anteil "zu hoch prognostiziert". Ergänze dafür zunächst die Anzahl der Beobachtungen je Warengruppe (Anzahl), um danach den absoluten Anteil (Anteil_abs) und relativen Anteil (Anteil_rel) zu ermitteln.
prog_naiv_gewMW_4W <- prog_naiv_gewMW_4W %>%
  group_by(Warengruppe) %>%
  mutate(Anzahl = n())

prog_naiv_gewMW_4W %>% 
  group_by(Warengruppe, Prognose_zuhoch) %>%
  summarise(Anteil_abs = n(), Anteil_rel = round(n() / mean(Anzahl) * 100))

## # A tibble: 10 x 4
## # Groups:   Warengruppe [5]
##    Warengruppe Prognose_zuhoch Anteil_abs Anteil_rel
##          <dbl> <lgl>                <int>      <dbl>
##  1           1 FALSE                 1033         48
##  2           1 TRUE                  1112         52
##  3           2 FALSE                  985         46
##  4           2 TRUE                  1160         54
##  5           3 FALSE                 1007         47
##  6           3 TRUE                  1138         53
##  7           4 FALSE                  977         47
##  8           4 TRUE                  1121         53
##  9           5 FALSE                 1000         47
## 10           5 TRUE                  1145         53

# Prognosegüte: mittlere Abweichung, Standardabweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung, das 5% und das 95% Quantil für die Abweichung
prog_naiv_gewMW_4W %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n(), mittlUmsatz=mean(Umsatz), mittlAbw=mean(Abweichung), StdAbw=sd(Abweichung), mittlAbw_abs=mean(Abweichung_abs), mittlAbw_rel=round(mean(Abweichung_abs)/mean(Umsatz)*100), mittlAbw_quad=sum(Abweichung_quad)/n(), Abweichung_Q5 = quantile(Abweichung,  probs = c(0.05)), Abweichung_Q95 = quantile(Abweichung,  probs = c(0.95)))

## # A tibble: 5 x 10
##   Warengruppe Anzahl mittlUmsatz mittlAbw StdAbw mittlAbw_abs mittlAbw_rel
##         <dbl>  <int>       <dbl>    <dbl>  <dbl>        <dbl>        <dbl>
## 1           1   2145       125.   -0.189    35.4         25.4           20
## 2           2   2145       399.    0.435    79.9         58.4           15
## 3           3   2145       166.   -0.120    44.3         32.8           20
## 4           4   2098        87.2   0.0487   28.5         20.3           23
## 5           5   2145       277.    0.395   104.          47.7           17
## # ... with 3 more variables: mittlAbw_quad <dbl>, Abweichung_Q5 <dbl>,
## #   Abweichung_Q95 <dbl>

# visualisiere die relative Abweichung im Histogramm: Erhalte eine Verteilung der Abweichung
naiv_gewMW_4W_relAbw_hist <- ggplot(data = prog_naiv_gewMW_4W, aes(x = Abweichung_rel*100)) + 
  geom_histogram(binwidth = 5, fill="purple", color="black", size=0.5) +
  ggtitle("Schätzung auf Basis des gewichteten Vorwochendurchschnitts: Rel. Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Anzahl Beobachtungen")
  
# ermittle die Dichteverteilung für die Abweichung
naiv_gewMW_4W_relAbw_dens <- ggplot(data = prog_naiv_gewMW_4W, aes(x = Abweichung_rel*100)) + 
  geom_density(fill="purple", color="purple", size=0.5, alpha = 0.3) +
  ggtitle("Schätzung auf Basis des gewichteten Vorwochendurchschnitts: Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte")

# zeige das Histogramm und die Dichteverteilung
naiv_gewMW_4W_relAbw_hist

naiv_gewMW_4W_relAbw_dens

Die Verteilung der relativen Abweichung erscheint zwar breit. Aber es scheint weniger Ausreißer nach oben zu geben, als in den anderen naiven Modellen. Unser naiver Schätzer auf Basis des gewichteten Vorwochendurchschnitts liefert insgesamt keine gute Umsatzprognose. Augenscheinlich gibt es einige Prognosewerte, die deutlich zu hoch sind. Diese Ausreißer wollen wir nun näher untersuchen, um zu verstehen, an welchen Stellen unser Modell noch Probleme hat. Für die Untersuchung der Prognosegüte hatten wir den Datensatz prog_naiv_gewMW_4W erstellt, mit dem wir jetzt weiter arbeiten.

# Untersuche die Fälle, in denen die Prognose mehr als 100% höher war als der Umsatz. Die Ausreißer verteilen sich folgendermaßen auf die Warengruuppen:
prog_naiv_gewMW_4W %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Warengruppe) %>%
  summarise(Anzahl=n())

## # A tibble: 5 x 2
##   Warengruppe Anzahl
##         <dbl>  <int>
## 1           1     33
## 2           2      2
## 3           3      4
## 4           4     38
## 5           5     14

# Offenbar haben wir ein Problem für die Warengruppen 1 (Brot) und 4 (Konditorei), die wir näher betrachen wollen. Untersuche, ob Feiertage die Ursache sind:
prog_naiv_gewMW_4W %>%
  filter(Abweichung_rel > 1, Warengruppe == 1 | Warengruppe == 4) %>%
  group_by(Warengruppe, Feiertag) %>%
  summarise(Anzahl=n())

## # A tibble: 3 x 3
## # Groups:   Warengruppe [2]
##   Warengruppe Feiertag Anzahl
##         <dbl>    <dbl>  <int>
## 1           1        0     23
## 2           1        1     10
## 3           4        0     38

# Für die Warengruppe 1 (Brot) spielen Feiertage bei den größeren Ausreißern eine Rolle. Das alleine liefert uns aber keine nennenswerten Erkenntnisse. Untersuche, ob einzelne Wochentage besonders betroffen sind, jetzt wieder über alle Warengruppen:
prog_naiv_gewMW_4W %>%
  filter(Abweichung_rel > 1) %>%
  group_by(Wochentag_c) %>%
  summarise(Anzahl=n())

## # A tibble: 7 x 2
##   Wochentag_c Anzahl
##   <chr>        <int>
## 1 Dienstag         8
## 2 Donnerstag      15
## 3 Freitag          6
## 4 Mittwoch        15
## 5 Montag          14
## 6 Samstag         17
## 7 Sonntag         16

# Für alle Wochentage ähnlich.

Die Schätzung auf Basis des gewichteten Durchschnitts der letzten 4 Wochen liefert offenbar für alle Wochentage wenig Ausreißer nach oben.

Wir werfen nun einen Blick auf die Top10 Abweichungen (Abweichung_rel) nach oben und nach unten: Für welche Tage liegt der Schätzer auf Basis des Vorwochenwertes besonders weit daneben? Oder gibt es Warengruppen, für die der Schätzer besonders viele große Ausreißer aufweist?

# sortiere nach der relativen Abweichung und zeige die ersten und letzten 10 Zeilen
prog_naiv_gewMW_4W %>%
  arrange(Abweichung_rel) %>%
  head(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [2]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-12-31           5  1870.  2015           0          7        2  
##  2 2013-12-31           5  1626.  2013           0          4        5  
##  3 2016-12-31           5  1705.  2016           0          7        4.9
##  4 2014-12-31           5  1879.  2014           0          6        7.4
##  5 2018-12-31           5  1668.  2018           0          7        7.4
##  6 2017-12-31           5  1432.  2017           0          7        8.2
##  7 2016-02-04           4   213.  2016           0          5        4.2
##  8 2016-05-16           4   221.  2016           0          5       11.2
##  9 2015-02-06           4   220.  2015           0          2       -0.5
## 10 2016-02-06           4   192.  2016           0          7        9.4
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

prog_naiv_gewMW_4W %>%
  arrange(Abweichung_rel) %>%
  tail(n=10)

## # A tibble: 10 x 59
## # Groups:   Warengruppe [3]
##    Datum      Warengruppe Umsatz  Jahr KielerWoche Bewoelkung Temperatur
##    <date>           <dbl>  <dbl> <dbl>       <dbl>      <dbl>      <dbl>
##  1 2015-10-18           1   23.1  2015           0          8       11.1
##  2 2014-03-02           4  108.   2014           0          6        6.6
##  3 2018-04-02           1   43.2  2018           0          5        6.1
##  4 2017-04-22           1   81.4  2017           0          5        7.5
##  5 2017-01-07           5  266.   2017           0          8       -0.5
##  6 2019-01-07           5  250.   2019           0          8        5.9
##  7 2015-01-07           5  263.   2015           0          6        5.8
##  8 2014-01-07           5  211.   2014           0          7       10.4
##  9 2016-01-07           5  212.   2016           0          7       -4  
## 10 2017-04-17           1   23.2  2017           0          6        6.2
## # ... with 52 more variables: Windgeschwindigkeit <dbl>, Wochentag <dbl>,
## #   Monat <dbl>, Wochentag_c <chr>, Monat_c <chr>, Wochenende <dbl>,
## #   SommerferienSH <dbl>, SommerferienNRW <dbl>, SommerferienNDS <dbl>,
## #   SommerferienHE <dbl>, Feiertag <dbl>, Ostern <dbl>,
## #   ChristiHimmelfahrt <dbl>, Pfingsten <dbl>, TDE <dbl>, Silvester <dbl>,
## #   Ostern_ext <dbl>, ChristiHimmelfahrt_ext <dbl>, Pfingsten_ext <dbl>,
## #   Silvester_ext <dbl>, Jahreszeit <chr>, Fruehling <dbl>, Sommer <dbl>,
## #   Herbst <dbl>, Winter <dbl>, Umsatz_NA <lgl>, Umsatz_lag_1W <dbl>,
## #   Umsatz_lag_2W <dbl>, Umsatz_lag_3W <dbl>, Umsatz_lag_4W <dbl>,
## #   Umsatz_lag <dbl>, Umsatz_gewMW_4W <dbl>, Umsatz_lag_1T <dbl>,
## #   Umsatz_lag_2T <dbl>, Umsatz_lag_3T <dbl>, Umsatz_lag_4T <dbl>,
## #   Umsatz_lag_5T <dbl>, Umsatz_lag_6T <dbl>, Umsatz_lag_7T <dbl>,
## #   Umsatz_lag_8T <dbl>, Umsatz_lag_13T <dbl>, Umsatz_lag_14T <dbl>,
## #   Umsatz_glDS_3T <dbl>, Umsatz_glDS_3T_erw <dbl>, Umsatz_temp <dbl>,
## #   Umsatz_glDS_4T_erw <dbl>, Prognose_zuhoch <lgl>, Abweichung <dbl>,
## #   Abweichung_abs <dbl>, Abweichung_rel <dbl>, Abweichung_quad <dbl>,
## #   Anzahl <int>

Für Silvester liefert unser naiver Schätzer auf Basis des erweiterten gleitenden Durchschnitts der letzten 4 Wochen- bzw. Wochenendtage offenbar systematisch zu niedrige Prognosen, besonders für Warengruppe 5 (Kuchen), was vermutlich am Verkauf der Berliner liegt. Das war zu erwarten, weil Silvester immer sehr umsatzstarke Tage sind. Ebenso liefert das Modell für den 7. Januar konsequent zu hohe Schätzwerte, weil diese - zumindest zu einem großen Teil (50%) - auf Basis der sehr hohen Silvester-Umsätze prognostiziert werden.

5.6 Vergleich der naiven Modelle

Wir wollen jetzt die Ergebnisse der verschiedenen naiven Modelle vergleichen. Und zwar beschränken wir uns auf das Jahr 2018, weil wir die späteren Modelle (lineare Regression, Support Vector Machines, Multilayer-Perceptron,…) ebenfalls für das Jahr 2018 testen werden und einen Vergleich zu den naiven Modellen herstellen wollen.

Wir haben in diesem Kapitel die folgenden Analysedatensätze verwendet und gefüllt:

• prog_naiv_lag_1W
• prog_naiv_glDS_3T
• prog_naiv_glDS_3T_erw
• prog_naiv_glDS_4T_erw
• prog_naiv_gewMW_4W

prog_naiv_vgl_relAbw <- df_naiv %>%
  filter(Umsatz_NA == FALSE) %>% # fehlende Umsätze in den Rohdaten raus nehmen
  filter(Datum >= "2013-08-01") %>%  # starte ab 01.08.2013
  dplyr::select(Datum, Warengruppe, Jahr, Wochentag, Wochentag_c, SommerferienSH, Feiertag) # behalte nur diese Spalten

prog_naiv_vgl_relAbw <- prog_naiv_vgl_relAbw %>% 
  mutate(lag_1W = prog_naiv_lag_1W$Abweichung_rel) %>%
  mutate(glDS_3T = prog_naiv_glDS_3T$Abweichung_rel) %>%
  mutate(glDS_3T_erw = prog_naiv_glDS_3T_erw$Abweichung_rel) %>%
  mutate(glDS_4T_erw = prog_naiv_glDS_4T_erw$Abweichung_rel) %>%
  mutate(gewMW_4W = prog_naiv_gewMW_4W$Abweichung_rel)

prog_naiv_vgl_relAbw <- prog_naiv_vgl_relAbw %>% 
  pivot_longer(cols=-c("Datum", "Warengruppe", "Jahr", "Wochentag", "Wochentag_c", "SommerferienSH", "Feiertag"), names_to="Modell", values_to="Abweichung_rel")

prog_naiv_vgl_relAbw %>%
  filter(Jahr == 2018 & Warengruppe==1) %>%
  ggplot(mapping=aes(x=Abweichung_rel*100)) +
  geom_density(aes(color=Modell), alpha=0.3) + 
  scale_color_manual(breaks = c("lag_1W", "glDS_3T", "glDS_3T_erw", "glDS_4T_erw", "gewMW_4W"), values=c("steelblue", "red", "yellow", "orange", "purple")) +
  ggtitle("2018 / WG1 - Vergleich der naiven Modelle: Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte") +
  xlim(-100, 200)

## Warning: Removed 13 rows containing non-finite values (stat_density).

prog_naiv_vgl_relAbw %>%
  filter(Jahr == 2018 & Wochentag_c=="Montag") %>%
  ggplot(mapping=aes(x=Abweichung_rel*100)) +
  geom_density(aes(color=Modell), alpha=0.3) + 
  scale_color_manual(breaks = c("lag_1W", "glDS_3T", "glDS_3T_erw", "glDS_4T_erw", "gewMW_4W"), values=c("steelblue", "red", "yellow", "orange", "purple")) +
  ggtitle("2018 / Montag - Vergleich der naiven Modelle: Relative Abweichung") +
  xlab("rel. Abweichung (%)") + 
  ylab("Dichte") +
  xlim(-100, 200)

## Warning: Removed 5 rows containing non-finite values (stat_density).

# Jahr 2018, alle Wochentage und Warengruppen
prog_naiv_vgl_relAbw %>%
  filter(Jahr == 2018) %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - Vergleich der naiven Modelle: Relative Abweichung") +
  xlab("Modell") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200)

## Warning: Removed 14 rows containing non-finite values (stat_boxplot).

# Jahr 2018, nur Montage, alle Warengruppen
# prog_naiv_vgl_relAbw %>%
#   filter(Jahr == 2018 & Wochentag_c=="Montag") %>%
#   ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
#   geom_boxplot() + coord_flip() +
#   ggtitle("2018 / Montag - Vergleich der naiven Modelle: Relative Abweichung") +
#   xlab("Modell") + 
#   ylab("rel. Abweichung (%)") +
#   ylim(-100, 200)

# Jahr 2018, nur Sonntage, alle Warengruppen
#prog_naiv_vgl_relAbw %>%
#  filter(Jahr == 2018 & Wochentag_c=="Sonntag") %>%
#  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
#  geom_boxplot() + coord_flip() +
#  ggtitle("2018 / Sonntag - Vergleich der naiven Modelle: Relative Abweichung") +
#  xlab("Modell") + 
#  ylab("rel. Abweichung (%)") +
#  ylim(-100, 200)

# Jahr 2018, nach Wochentag, alle Warengruppen
# Wochentag_c sortiert nach Wochentag
prog_naiv_vgl_relAbw %>%
  filter(Jahr == 2018) %>%
  mutate(Wochentag_ord = reorder(Wochentag_c,Wochentag)) %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - Vergleich der naiven Modelle: Rel. Abweichung nach Wochentag") +
  xlab("Modell") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200) +
  facet_wrap(vars(Wochentag_ord))

## Warning: Removed 14 rows containing non-finite values (stat_boxplot).

# Jahr 2018, nach Warengruppen, alle Wochentage
prog_naiv_vgl_relAbw %>%
  filter(Jahr == 2018) %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 - Vergleich der naiven Modelle: Rel. Abweichung nach Warengruppe") +
  xlab("Modell") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200) +
  facet_wrap(vars(Warengruppe))

## Warning: Removed 14 rows containing non-finite values (stat_boxplot).

# Jahr 2018, nach Warengruppen, alle Wochentage, OHNE Sommerferien und OHNE Feiertage
prog_naiv_vgl_relAbw %>%
  filter(Jahr == 2018 & SommerferienSH == 0 & Feiertag == 0) %>%
  ggplot(mapping=aes(x=Modell, y=Abweichung_rel*100)) +
  geom_boxplot() + coord_flip() +
  ggtitle("2018 OHNE SoFerien u. Feiertage - Vgl. der naiven Modelle: Rel. Abw. nach Warengruppe") +
  xlab("Modell") + 
  ylab("rel. Abweichung (%)") +
  ylim(-100, 200) +
  facet_wrap(vars(Warengruppe))

## Warning: Removed 7 rows containing non-finite values (stat_boxplot).

# starte mit lag_1W: Ergänze die benötigten Hilfsgrößen
prog_naiv_lag_1W <-  prog_naiv_lag_1W %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_lag_1W %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "lag_1W")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- temp

# weiter mit glDS_3T: Ergänze die benötigten Hilfsgrößen
prog_naiv_glDS_3T <-  prog_naiv_glDS_3T %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_glDS_3T %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "glDS_3T")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

# weiter mit glDS_3T_erw: Ergänze die benötigten Hilfsgrößen
prog_naiv_glDS_3T_erw <-  prog_naiv_glDS_3T_erw %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_glDS_3T_erw %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "glDS_3T_erw")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

# weiter mit glDS_4T_erw: Ergänze die benötigten Hilfsgrößen
prog_naiv_glDS_4T_erw <-  prog_naiv_glDS_4T_erw %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_glDS_4T_erw %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "glDS_4T_erw")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

# weiter mit gewMW_4W: Ergänze die benötigten Hilfsgrößen
prog_naiv_gewMW_4W <-  prog_naiv_gewMW_4W %>%
  mutate(Abweichung_rel_abs = abs(Abweichung_rel), Abweichung_rel_abs_mult_umsatz = Abweichung_rel_abs * Umsatz)

# Prognosegüte: mittlere Abweichung, mittlere absolute / relative Abweichung, mittlere quadratische Abweichung
temp <- prog_naiv_gewMW_4W %>%
  group_by() %>%
  filter(Jahr==2018) %>%
  summarise(Anzahl=n(), Umsatz_ges = round(sum(Umsatz)), Umsatz_mittel = round(sum(Umsatz)/n()), MAE = round(mean(Abweichung_abs)), MPE = round(mean(Abweichung_rel)*100), MAPE = round(mean(Abweichung_rel_abs)*100), WAPE = round(sum(Abweichung_rel_abs_mult_umsatz)/sum(Umsatz)*100), MSE = round(mean(Abweichung_quad)), RMSE = round(sqrt(mean(Abweichung_quad))), rRMSE = round(RMSE/Umsatz_mittel*100))

# füge das Modell hinzu
temp <- temp %>% mutate(Modell = "gewMW_4W")

# füge die Kennzahlen nun an die Vergleichstabelle
prog_naiv_vgl_kennz <- rbind(prog_naiv_vgl_kennz, temp)

head(prog_naiv_vgl_kennz)